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LLELLLLLLLLLLLLL IIIIIIIII BBBBBBBBBBBB RRR RRR TTT LELLLLLLLLLLLLL Ll 
LLELLLLLLLLLLLLL TITIII111 BBBBBBBBBBBB RRR RRR TTT LI 
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1 
1 LIBRTL.SRCJSTRARITH.B32;1 (1) 
' 
' 


ci 9 001 0 MODULE STRSARITH | ; 
; ¢ Oe — = '1-019' ! File: STRARITH.B32 EDIT:STAN1019 : 
Pt ooe ea ar | 
: § 68 ! ee eee ne eee nea ae aro : 
3 '® * 3 
; 8 008 1 !* COPYRIGHT (c) 1978, 1980, 1982, 1984 B * 3 
; 9 009 1 i DIGITAL EQUIPMENT CORPORATION, MAYNARD. MASSACHUSETTS. ‘ 3 
3 19 Bois : . ALL RIGHTS RESERVED. * : 
Py . ® oe 
; 1g 8818 1 !® THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND gd ba * : 
: 1 1 1 !* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * ; 
3 14 0014 1 !* INCLUSION OF a & ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER’ * ; 
; 15 0015 1 !* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * ; 
: 16 0016 1 !* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * ; 
; \? gate ! :* TRANSFERRED. * 3 
; '® * 5 
; 19 0019 1 !* pe 3 INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * . 
: 20 0020 1 !* SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * : 
hee os) ! ? CORPORATION. * : 
° . ® . 
; $¢ 0098 1 !* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * ; 
; ra’ 0024 1 !* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. * : 
of Bae | 
. te ® e 
: 3 0037 1 PITITITITITILILTIL LLL LLL LILI LLL LiL Lili LiLiLiiiililiiiiiiiiiiiiiiiiiiiin PY 
$ 0 1! 3 
; $3 94 1 3 
3 0 0030 1 !++ 3 
3 H 0031 1 ! FACILITY: STRING Arithmetic : 
; ; te 1! ; 
3 3 003 1 ! ABSTRACT: $ 
; | 634 0034 1! F 
i = 0035 1! This module is a large-precision arithmetic package based on 3 
3 “8 ie ; decimal strings. : 
3 38 0038 | i ENVIRONMENT: VAX-11 User Mode 
i 40 | | AUTHOR: John Sauter, CREATION DATE: 01-MAR-1979 : 
3 4@ i MODIFIED BY: ; 
.. a 1: 1-001 - Original. JBS 05-MAR-1979 ; 
: 645 1! 1- ¢ - Fix reciprocal of nusbers abesyeen AS and 1. JBS 07-MAR-1979 3 
; 646 1 ! 1-003 = Treat minus 0 as zero. S 22-MAR-1979 3 
or 1! 1-8 4 - Improve comments based r. oon pn 8 review. JBS 26-MAR-1979 3 
; 648 1 ! 1-005 = Free local strings in case of an error. JBS 07-MAY-1979 : 
; 6449 1 ! 1-006 - Make the entry points take scalars it reference, in honor $ 
; 50 1 i of the recognition of STR as a fac ity. ay BS24 {5-MAY-1979 : 
; 2) 1! 1 Change OTS$S and LIB$S to STR$. JBS on : 
: ¢ : 1-008 py 8, some e deleted by mistake in edit 80. ; 
: 54 1 ' 1-009 - Change sells to STRSCOPY. JBS Mis L-1979 ; 
; 5 1! 1- 19 - Correct a typo in a comment. JBS nis pt Apt ; 
: 28 1 ! 1-011 = When freeing strings after an error yeich out {or : 
3 7 1! descriptors not yet initialized. JBS 31-JUL- =1979 ; 


Be Seas “| 
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1-019 ~300n 138% Pt pet :01 AyeRTLeS gReisTRAMt 1078331 . (1) -0 
8 82 1-012 = Adde new sret tng - STRSOIVIDE. Also added related 

9 rout nes UPDATE _COUNTS ,CVT_STR_PACK d and tv sPACKED_ STR. 

60 Also changed thé existin String ar mee routines, so 

61 that they all call LIBSANALYZE OFC fo yerity that the 

6 06 input descriptors are vali . CB 

6 06 1-013 = Added updated code for STRSDIVIDE as hus as ancillary 

64 $e routines UPDATE oCOUNTS, CVT_STR_PACKED, and CVT_PACKED_ y STR. 

65 LB 16-NOV-81 

66 1-014 = Moved code to do the conversions to and from packed decimal 


AADO 


NOUS WPS COOODNOU LS WOO 


into module LIBPKARIT. Changed code in STRSDIVIDE to use 
left justification of BiB ingyt strings instead of right 


o 
~ 
SOoOoooooooooooooooooo 


H 1! 

: 1! 

: 1! 

; 1} 

: 1 i 

: 1! 

; 1! 

: 1! 

3 0 ss 

3 0 1! 

: 0 1! 

: ] $8 1! ws he te RNH 

; 0 1 ! 1-015 = Added code in qt Soting + et routines so that they correctly 
ert a 071 1! handle all str ng chegect, a te required the a eitten of a new 
a. 072 1! internal entry poi nt CHK_S YPE. LB 15=DEC- 

ER 075 1 ! 1-016 = Added code in STRSDIVIDE™ cS gins FS a section of "bo bytes to avoid 
; 74 074 1! random data being picked up & w. she gphtes tecee packed arithmetic 

: 75 075 1! routines that it calls. 

5 76 076 1 ! 1-017 = Added code to ensure that a resul of zero would always be returned 
; a pit ! as a positive value, LB 1i- “A 

:; 79 0079 1! by reference rather than by value. Initialize variable STORAGE 

;: 0080 1! on entry into S$ TREDIVIDE. Use its address rather than 13 contents 
a 0081 1! a gest = QSTRBUF in special zero- yor tent case. ord be for 
= 0082 1! sine © possibly propogate angther nto the quotient in 
Se 0083 1! STRSDI PRdjust calculation of ByTES. My i: STRSDIVIDE slightly 
;s #4 0084 1! to fix an access violation problem. 

>. & 0085 1! MDL 11-Mar-1 

; & 0086 1 ! 1-019 = Enlargened amount of VM that STRSDIVIDE gets to prevent an 

: 0087 1! access violation in certain cases. STAN 18-Jun-1984. 

: 88 0088 1 !-- 

; 8 0089 1 

s 0090 1 !<BLF/PAGE> 


1-018 - fixed” alt to LIBSFREE_VM at end of STRSDIVIDE to pass START_BUF 
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aa 


EXTERNAL REFERENCES: 


EXTERNAL WOVT IN 
LIBSSTOP 


TRSGET1 DX, 
SFREET Dx, 


; 
SCOPY 
SROUN 
$ 

$ 


PRAAPAAHAAS 


$ 
ST 
ST 
ST 
Ll 
Ll 
Ll 
Ll 
Ll 
Ll 
Ll 
Ll 


)-4-4-4-4-4.-4-4.4. 4. $24 


“PACK_RB:JSB2 
SSMUL"PACK-R10:JSB4 NOVALUE, 
LIBSS$ADJUST_Q_R9:JSB3 NOVALUE, 


10 
its 


12:20:61 


AX-11 Bliss-3 
LIBRTL.SRCJST 


@DrMm 


~1984 
sats A 


signet fatal error 

Allocate a ete ing 

Deallocate a string 

Copy a string by reference 

Copy a string | descriptor 
Allocate virtual memory 
Deallocate virtual memory 

Copy a string by reference 

Rounds quotient to correct length 
Calculates normalization factor 
Calculates one quotient digit 
Subtracts two decimal arrays 
Multiplies a packed array by a single 


entry 
Adjusts intermediate results of divi- 


sion algorithm if initial quess at 
a quotient digit is wrong 


of decimal di 
packed decima 


LIBSS$CVT_STR_PACK_R9:JSB3 NOVALU 


Converts a strin 
to an array o 
values 


pres 


4 
LIBSSCVT_PACK_STR_R8:JSB2 NOVALUE 
' Converts an array of packed decimal 
values to a strin 
Extract length and addr of a given 
descriptor and validate inputs 
Match condition codes 
Used to pad result with leading zeroes 


LIBSANALYZE_SDESC, 


LIBSMATCH_COND, 
STRSDUPL_CHAR; 


ee ee 


0909 09 09 09 C8 SI NINN SIN SSNS PA AAA AAA AMIE Bs BS 


BIND 
ZERO = UPLIT BYTE (REP 7 OF (2xX'00"),%xX'OC'), ! Packed zero 
TEN = UPLIT BYTE (REP 6 OF (%X'00"),£x'01" 2x"0C'), | Packed ten 
SPANC_TABLE = UPLIT BYTE (REP 48 OF (%x'00"), REP fo oF (%x'01"), 
P 198 OF (%x'00')S, 
MASK = UPLIT BYTE (REP 1 OF (2%X'01')); 
BUILTIN . 
CMPP, ' Compare packed decimal data 
MOVP ' Move packed decimal data : 
SPANC; ! Skip over a set of characters in a character string 


te 
: The following are the error codes produced by this module. 


ee ee a ee ee ee ee ee a dd a hd od 
co 
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EXTERNAL LITEFAL 
ST BS“DIVBY SER 
STRS~WRONURARG: 


! Invalid argument 
' Divide by zero. 
! Wrong number of arguments 
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GLOBAL ROUTINE STRSADD ( ! Add two strings 
A e Sign of operand 


SELF 


A 
Decimal exponent of operand A 
Df ° Ta 


Zoononwwwr>,r 
ooMvoomMm 


) 


DODQDOOCOOCOCOONOO 


ARO OONAU EWR 0 OD NOUN EWN 9 OD NAN EWN | O OONAU EWN SO CONAUES UW" O0OO~ 


'o4¢ 


; FUNCTIONAL DESCRIPTION: 
Add two decimal numbers. ( := A+B 
FORMAL PARAMETERS: | 
| 

| 


ASIGN.rv.r 0 = operand A is positive, 1 = ag ee 
AEXP.rl.r Power of 10 by which to multiply the operand A 
digits to get the absolute ya ue of operand A. 
E.g., AEXP = 1, ADIGITS = 125 gives 1230. 
ign eee Descriptor for the digits of operand A 


POPOPIPIPIPIPOPUPIPONINININONPononounonononononufnopfnonorny 


WWWAAAAI AA AIR PPUPPYNIPININYD 2 I? SS SO OS OS 


ViFWUN—OOCBNOUVUESWN —“OVOONOUS wr 


NONE 
SIDE EFFECTS: 


May allocate space for the CDIGITS string. 
Signals if storage is exceeded. 


1 
1 
1 
1 
1 
1 
1 
1 
1 
1 
IGN.rv.r 0 = operand B is positive, 1 = negative 
BEXP.rl.r Power of 10 by which to multiply the operand B 
digits to get the absolute value of operand B. 
E.g.. BEXP = -1, BDIGITS = 123 gives 12.3. 
2 2 BDIGITS.rnu.d Descriptor for the digits of operand B 
2 2 CSIGN.wl.r 0 = operand C is positive, 1 = negative 
236 2 CEXP.wl.r Power of 10 by which to multiply the operand C 
237 2 digits to get the absolute ¥3 ue of operand C. 
238 § E.g.. CEXP = 0, CDIGITS = 125 gives 123. 
+44 CDIGITS.wnu.d Descriptor for the digits of operand C 
sei 3 IMPLICIT INPUTS: 
3 
str NONE 
re: 3 ! IMPLICIT OUTPUTS: 
8 ; NONE 
8 
4 ROUTINE VALUE: 
0 ri COMPLETION CODES: 
4 
4 


BEGIN 
MAP 


NBII a a tt 5 8 th a a st 


PROPIPIPOPONIPININIMIAPININININPoPy 
PADMA & & & & 
M—OO@BNOuflwn—oo 


Wn & & 
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‘+ 
: Enable a handler to free the local strings in case of an error. 


NABLE 
FREE_STRINGS (A_DESC, B_DESC, R_DESC); 


; 3 4 ADIGITS : REF BLOCK (8, BYTE), 

; 264 5 BDIGITS : REF BLOCK (8, BYTE), 

3 66 8 CDOIGITS : REF BLOCK (8, BYTE); 

: 26 LOCAL 

; 268 § ' 

; ; re Internal form of A 

: 271 o¢ A_DESC : BLOCK (8, orth? VOLATILE, 
: ev 6 ABUF : REF VECTOR (65555, BYTEJ, 

s; a 64 A_LEN, 

° 74 65 A_SIGN, 

: 75 r¢] ‘+ 

3 re 6 ' Internal form of B 

: ar 68 t- 

; 278 69 B_DESC : BLOCK (8, erred VOLATILE, 
: e279 70 BBUF : REF VECTOR (65535, BYTE), 

; 280 71 B_LEN, 

; 281 4 B_SIGN, 

; see 037 '¢ 

3 8 0374 ' Local copy of result. 

: 284 0375 t= 

: 285 0376 RSIGN, 

; 286 0377 REXP 

: 287 0378 R_DESC : BLOCK (8, BYTE) VOLATILE, 
3; 288 0379 RBUF : REF VECTOR (65535, BYTE], ' Addresses result 
3 er 0380 R_LEN ! Length of result 
; 4 0381 RESULT_DIGITS, ! Number of digits in result 
: $93 0888 5 14 

3 238 8 rf } The following locals are needed for calls to LIBSANALYZE_SDESC. 
: 95 0 56 CBUF, 

; 296 0 : C_LEN 

> 297 0388 STATUS; 

; 298 0389 

3 0390 

3 0391 BUILTIN 

3 8 4 ACTUALCOUNT; 

3 9 

3 94 

3 3 

39 

: 98 

; 99 

; 

g 5 

3 0 


BRR EEE F&F FAW AAA AAA AAAI 


AI.AAIANIA AAA AAA AAAI AAAI AAAI 
pad band athestp ib aeaade eee 


0 '¢ 

; : Check for the proper number of arguments. 

4 IF (ACTUALCOUNT () LSS 9) 

5 THEN 

§ BEGIN 

8 8 LOCAL 

9 10 ROUT_NAME_DESC : BLOCK (3, BYTE); 


— os 
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411. 

tig ROUT_NAME _DESC (CDOSCSW_LENGTH] = 7; 

4] ROUT “NAME _DESC DSC$B_DTY PE, = DSCSK_DTYPE_T; 
414 ROUT_NAME DESC LDSCSB_CLASSJ = DSCSK $LASs S; 

15 T_NAME 4344 DSCSA-POINTER] = UPLTT (ZASCII'STRSADD') 
21$ LIBSSTOP TSTRS$_WRONUMARG, 2, ACTUALCOUNT (), ROUT NAME _péso); 
Qt 
4) ‘+ 
? ; Copy the A and B operands, taking the tens complement of the negative 

' ones. 

4 !- 

" g A_DESC CDOSC$W_LENGTH) = 0; 

424 A~DESC DSC$B_DTYPE] = DSCSK_DTYPE_NU; 

0425 A_DESC CDSC$B_CLASSJ = DSCS$K_CLASS_D; 

Be § ee A_DESC COSCSA_POINTER] = 0; 

0428 ! Compute the Length of operand A. Only the leading digits count. 
0429 ' (Somday use SCAN or SPAN for this.) 

0430 ! First call LIBSANALYZE ay ® fe ensure that the input descriptor 
0431 ! is valid. If it is, then ABUF will contain the address of the 
RL first byte of the shrine. ~~ A_LEN will contain its length. 
0434 
0435 STATUS = LIBSANALYZE soese (. ADIGITS,A_LEN,ABUF); 

Bees IF .STATUS NEQ SS$_NORMA 
0437 THEN 
0438 LIBSSTOP (LIBS_INVARG); 
0439 
0440 + 
0441 i Check here for the CDIGITS descriptor before getting too involved 
044 i in the routine. 

ez § 
0445 é STATUS = LIBSANALYZE SDESC (.CDIGITS,C_LEN, CBUF); 
0446 IF .STATUS NEQ SS$ _NORMA 
0447 2 THEN 
0448 LIBSSTOP (LIBS_INVARG) ; 
0449 A_LEN = 
0450 A_SIGN = * -ASIGN: 
0451 BEGIN 

$36 

45 LOCAL 

454 SCAN_DONE ; 

455 

$28 SCAN_DONE = 0; 

45 

458 DO 

459 & BEGIN 

460 4 

red ? IF C-ALLEN EQLU .ADIGITS COSCS$W_LENGTH]) 

465 4 SCAN_DONE = 

ag em 

466 5 IF ((.,ABUF C.A_LEN] GEQ %C°O") AND (.ABUF C.A_LEN] LEQ %C€'9')) 
0467 4 THEN 


OO 
—O0O°w 
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A_LEN = .A_LEN + 1 
ELS 
SCAN_DONE = 1; 


END 
UNTIL (.SCAN_DONE); 


ND; 
LEN = .A_LEN + 1; ! Extra digit for si 
Arbiter Ae (A_LEN, A_DESC); - Fae ka 

ABUF = =PES¢ tDSéSAzPOINTERI; 
ABUF [03 = %C‘O'; 
CHSMOVE (.A_LEN = 1, .ADIGITS COSCS$A_POINTER], ABUF (1); 
LF (.A_SIGND 
BEGIN 


i Take the tens complement of the A operand. This is done by 
! subtracting each digit from 9, and adding 1 to the result. The final 
add can cause carries. 


pole lolelelolololeajlealelaleleleoleleloloala) 


FRRRRR RRR RRR RRR PRPS 
0200000900 09 0909 J NINN NNN 


NOUEAN (OC OONAOUS Wry 


MP RoRORUROPOnony 2 2 oe 


BV SOONAUE UM OOO NOME WN SO 


PBS BB DIA AA IT II BB I BB BEE EE EWI WNW WIA GOPPPINININIWIN EE BPE 


FW OOO VEIN OC OONOAUES WN OO 


: 


eer altal ah ah al ah Ab Ab Ab Ah Ab Ab Abad Ab ab Ab Ab Ab Ab Ab Ab Ar ed 
RPMI 2 2 OO OS MH ODOOOOSOOCOCCS Oo 


Foe ot a? at at at ot af ot ot ot ot at at ee ee 


DECR COUNTER FROM .A_LEN = 1 TO 0 DO 
ABUF C.COUNTER] = (9 = (.ABUF C.COUNTER] - %C'O')) + %C'0'; 


BEGIN 


CAL 
CARRY_DO 


NE 
CARRY COUNTER; 
CARRY_DONE = 0; 


CARRY-COUNTER = .A_LEN = 1; 
IF (.CARRY_COUNTER GEQ 0) 
THEN 


dO 
BEGIN 
ABUF C.CARRY_COUNTER] = .ABUF C.CARRY_COUNTER]) + 1; 
IF (.ABUF C.CARRY_COUNTER] LEQ %C'9") 


CARRY_DONE = 1 
ELSE 


ABUF C.CARRY COUNTER) = .ABUF C.CARRY_COUNTER]) - 10; 
Eoant Coates = .CARRY_COUNTER - 1; 


END 
UNTIL ((.CARRY_DONE) OR (.CARRY_COUNTER LSS 0)); 
IF ( NOT .CARRY_DONE) THEN A_SIGN = 0; 
END; 


- 
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; : ¢ 5 END; 
; 4 5 B_DESC CDSCS$W_LENGTH) = 0; 
: 4 2 B-DESC DSC$B_DTYPE4 = DSCSK_DTYPE_NU; 
; 4 5 529 B_DESC LDSCSB_CLASSJ = OSE K CLASS Di 
3 tis ; , = B_DESC LDSCSA_POINTER] = 0; 
: 441 § ! Compute the teogth of operand B. Only the leading digits count. 
; «464 5 ' First gait LIBSANALYZE_SDESC to oe that the input descriptor 
3; 44 534 ' igs valid. If it is, then BBUF w contain the address of the 
; tte 03 é first byte of the string, and B_LEN will contain its length. 
3 44 
3 «44 0538 STATUS = LIBSANALYZE 4 bg (.BDIGITS,B_LEN, BBUF); 
; 4468 0539 IF_.STATUS NEQ SS$_NORMA 
; 449 0540 THEN 
; 450 0541 1 3 (LIBS_INVARG) ; 
; 451 Beg B_LEN = 
; $26 054 B-SIGN = ..BSIGN; 
; 45 0544 BEGIN 
3; 4454 0545 
; 455 B26 LOCAL 
3; 456 054 SCAN_DONE; 
: 457 0548 
: 458 0549 SCAN_DONE = 06; 
; 459 0550 
; 460 0551 DO 
; 461 3226 4 BEGIN 
; 46 0553 4 , 
; 46 0554 5 IF (.B_LEN EQLU .BDIGITS COSC$W_LENGTHJ) 
> 464 Bee? 4 
3 465 556 4 SCAN_DONE = 1 
: 466 0557 4 SE 
; 467 0558 4 
; 468 0559 5 IF ((.BBUF C.B_LEN] GEQ %C°O") AND (.BBUF C.B_LEN] LEQ %C'9")) 
3: 469 0560 4 THEN 
; 470 0561 4 B_LEN = .B_LEN + 1 
: «471 3206 4 ELS 
; 47 0565 4 SCAN_DONE = 1; 
3; 47 0564 4 
: 474 0565 4 END 
3; 475 0566 UNTIL (.SCAN_DONE); 
: 476 567 
3 477 568 END: —_ ; 
3; 478 569 LEN B_LEN ‘e 3 ! Extra digit for sign | 
: 479 pene STRSGET1 “OR (8. 
: 480 571 BBUF =PES iis POINTER): | 
> 481 057¢ BBUF [0] = 
3 re Bat? CHSMOVE ( Ny ten: - 1, .BDIGITS CDOSCSA_POINTER], BBUF [1]); 
: 4 575 IF (.8_SIGN) | 
3; «485 278 N 
; 4 57 BEGIN 
: rt 278 
; 488 57 i Take the tens complement of the B operand. This is done by 
: 489 289 ! subtracting each digit from 9, and adding 1 to the result. The final 
; 490 581 i add can cause carries. 
| 


" 
TREARITH 1h-Sep=1984 01:27:51 VAK#11 BLiss-32 v4.0-76 Pp 
31619 ence oke Poighion «= Neat ebdessté Soe 


£33 B he 
49 i DECR COUNTER FROM, .B.LEN - 1 10 0 00 
494 5 BBUF C.COUNTER) = (9 = (.BBUF C.COUNTER] - %C'O")) + %C'O’; 
49 ; ; BEGIN 
49 8 
498 289 CAL 
4 0 CARRY_DONE 
591 
$34 CARRY-COUNTER = .B_LEN = 1; 
0596 IF (.CARRY_COUNTER GEQ 0) 
59 THEN 
598 
599 D0 
0600 


BEGIN 
BBUF C.CARRY_COUNTER] = .BBUF C.CARRY_COUNTER] + 1; 
IF _(.BBUF C.CARRY_COUNTER] LEQ X¢'9") 

CARRY_DONE = 1 


BEGIN 
BBUF C.CARRY COUNTER] = .BBUF C.CARRY_COUNTER] - 10; 
EARRY COUNTER = .CARRY_COUNTER = 1; 


END 
UNTIL ((.CARRY_DONE) OR (.CARRY_COUNTER LSS 0)); 
IF ( NOT .CARRY_DONE) THEN B_SIGN = 0; 


'¢ 
!' Compute a tenative result exponent based on the smallest exponent 
} in either A or B,. 


: REXP = MIN (..AEXP, ..BEXP); 


! 
i allocate enough space to hold the maximum possible number of result 
! digits. This is done by spanning the powers of ten involved in the 


CARRY~ COUNTER; 
CARRY_DONE = 0; 
two input operands, and adding 1 for carry. 


Www IA APSPOPOPONOfoPoNPoPINn) 
On she 2 Die a A DODO NONE UI ODN AF UMVUODS ee RR owe 


RESULT_DIGITS = (MAX_(..AEXP + .A_LEN, ..BEXP + .B_LEN)) + 1 = .REXP; 
R_DESC”([DSC$W_LENGTH) = 0; 
R-DESC DSC$B-DTvPE = DSC$K_DTYPE_NU; 
R-DESC [CDSC$B~CLASS] = DSCSKICLASS_D; 
DESC DSCSA-POINTER) = 0; 
STRSGET1_DX (RESULT DIGITS, R_DESC); 
UF = .R_DESC DSCSA POINTERT; 
R_LEN = .R_DESC CDSCSO_LENGTHI: 


POROROR ROR OR OROPUROROPORNUNUNONONNPONUNUW EE FB PUMA AOU BRU RR RE EEE PUI 


PUPP PUPIL PVPU DVS ST SU SUSUIU SUSI ST SISISTSTSISTSTISTSTIAIIIUII 


CONAN WP OO ONOU EWN — OVOONOU EWN — 


WIN AIA. AI AIA AI AO ROPURIPUNONMONLPADN 4-2 2 


SSSS3333S3F. OOoOoooooooooooooo 
PAA ¢-4-¢--¢-¢-9-¢-¢-4-9.0-¢-¢.0.0-0-0-0.0-4 


Oe Ge Ge Oe Ge ee ee 
tt et et ete 


PUPS SISISIIVIIT LE 


OWONAVLSW—OOD 
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QED DPVDVSUSPVSPVSISTSISISISISISIV 


AAO 
wr 


$ 
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SSS arn 
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SESSESE. 
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! Copy the A operand into the result string, offsetting it properly 
; based on the exponents. 
CHSFILL (%C°O', .R_LEN, .R_DESC COSCSA_POINTER)); 
CHSMOVE f-AAbEN A_DESC COstsh POINTER], ! 
7 -R_DESC"CDSCSA_POINTER] + .R_LEN = (..AEXP = .REXP) = .A_LEN); 


If the A operand was negative we owe high-order nines. 


IF (.A,SIGN) THEN CHSFILL (2C'9", (.R_LEN = .A_LEN) = (..AEXP = .REXP), .R_DESC CDSCSA_POINTER)); 


'¢ 
Now add in the B operand. 


spooen™ + ha FROM (.R_LEN = 1 = (..BEXP = .REXP)) TO (.R_LEN = 1 = (..BEXP = .REXP) = (.B_LEN = 1)) DO 


~s INDEX 
som; 


B_INDEX = ,COUNTER = (.R_LEN = 1 = (..BEX 
SOM = .RBUF C.COUNTER] +” .BBUF C.B_INDEX) 


IF (.SUM GTR %C'°9") 
is “BEGIN 
We must propagate a carry to the higher digits of RBUF 


P = .REXP) = (.B_LEN - 1)); 
- 20'0'; 


LOCAL 

CARRY_DONE 

CARRY COUNTER; 
RBUF C.COUNTER] = .SUM - 10; 
ARRY_DONE = 0; 
CARRY-COUNTER = .COUNTER - 1; 
IF_(.CARRYCOUNTER GEQ 0) 
THEN 


Do 
BEGIN 
RBUF C.CARRY_COUNTER] = .RBUF [C.CARRY_COUNTER] + 1; 
IF (.RBUF C.CARRY_COUNTER] LEQ %¢'9") 
CARRY_DONE = 1 


RBUF C.CARRY COUNTER) = .RBUF C.CARRY_COUNTER] - 10; 
CARRY COUNTER = .CARRY_COUNTER = 1; 
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; 605 696 5 END 3 
: O06 3 2 UNTIL ((.CARRY_DONE) OR (.CARRY_COUNTER LSS 0)); ; 
3 one 38 4 END 3 
; 6 ? ELSE 3 
3 219 RBUF C.COUNTER] = .SUM; : 
3 olg 4 END; 3 
3; 61 4 $ 
; 6146 5 '+ 3 
; 615 $ ! End of the DECR Loop. 3 
3 918 = 3 
; 61 & ‘+ : 
3 213 44 If the B operand is negative, we owe high-order nines. : 
; 620 11 3 
; 621 12 IF (.B_ SIGN) ; 
3; 6 ¢ 1 THEN 3 
3 ? t 8 BEGIN 3 
: rer 16 DECR COUNTER FROM ((.R_LEN = 1 = (..BEXP = .REXP) = (.B_LEN = 1)) = 1) TO 0 DO ; 
; 626 17 4 BEGIN 3 
3; 627 18 4 3 
; 628 19 4 LOCAL $ 
8 7 - : 
3 ° 1 ; 2 SUM = .RBUF C.COUNTER] + 9; : 
4 ose 4 5 IF (.SUM GTR %C°9") ‘ 
; ret 3 - BEGIN : 
3 $3 7 : '¢ ; 
3 oer 8 : We must propagate a carry to the higher digits of RBUF : 
3; 639 0 5 3 
; 640 31 «5 3 
3 6641 3 5 CARRY_DONE 3 
; 642 33 5 CARRY COUNTER; F 
: 66 34 «CS 3 
; 645 38 5 CARRY_DONE = 0; 3 
; ets i : CARRY_COUNTER = .COUNTER - 1; 3 
3 648 35 IF (.CARRY_COUNTER GEQ 0) ; 
; 649 40 THEN F 
; 650 741 ; 
; 651 4 | dO 3 
; 636 43 6 BEGIN 3 
; $2? ee 6 RBUF C.CARRY_COUNTER] = .RBUF C.CARRY_COUNTER] + 1; 3 
; 655 28 5 IF (.RBUF C.CARRY_COUNTER] LEQ %C¢'9") é 
$ 626 747 6 THEN : 
; 65 748 6 CARRY_DONE = 1 3 
3 638 749 § 3 
, 69 750 3 
; 660 751 7 RBUF C.CARRY_ COUNTER) = .RBUF C.CARRY_COUNTER] = 10; 3 
; 661 752 7 CARRY_COUNTER = .CARRY_COUNTER - 1; | : 
| 
J 
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END; 
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END 
UNTIL ((.CARRY_DONE) OR (.CARRY_COUNTER LSS 0)); 


3 

4 

é 

END 

668 § ELSE 
669 60 RBUF C.COUNTER] = .SUM; 
en 2 eo 
ore 88 
67 64 END; 
674 65 
675 '+ 
o78 Compute the sign of the result and recomplement it if negative. 
678 
679 IF (.RBUF CO] GEQ %C'°5") 
680 THEN 
681 BEGIN 
re} RSIGN = 1; 
684 DECR COUNTER FROM .R_LEN = 1 TO 0 DO 
685 RBUF C.COUNTER) = (9 = (.RBUF C.COUNTER] - %C'0')) + %C'0'; 


BEGIN 


OCAL 
CARRY_DO 


NE 
CARRY~COUNTER; 
CARRY_DONE = 0 


CARRY-COUNTER = .R_LEN - 1; 
IF _(.CARRY_COUNTER GEQ 0) 
THEN 


dO 
BEGIN 
RBUF C.CARRY_COUNTER] = .RBUF C.CARRY_COUNTER] + 1; 
If (.RBUF C.CARRY_COUNTER] LEQ %C'9") 
CARRY_DONE = 1 
SE 


BEGIN 
RBUF C.CARRY_COUNTER) = .RBUF C.CARRY_COUNTER] - 10; 
CARRY. COUNTER = .CARRY_COUNTER - 1; 


A 
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7 
711 
ar END 
ay 3 UNTIL ((.CARRY_DONE) OR (.CARRY_COUNTER LSS 0)); 
715 END; 
at END 
71 ELSE 
718 8 RSIGN = 0; 


~N 
oO 
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1+ 
Discard low-order zeros, adjusting the exponent. 
BEGIN 


SCAN_DONE 
SCAN~COUNTER; 
SCAN_DONE = 0; 
SCAN-COUNTER = .RESULT_DIGITS = 1; 


dO 
BEGIN 


IF (.SCAN_COUNTER LSS 0) 


SCAN_DONE = 1 
ELSE 


END 
UNTIL (.SCAN_DONE); 


REXP = .REXP + ((.RESUL 


T DIGITS 
tad DIGITS = . SCAN_ COONTER + 


1 - 
R +1; 
14 
- Remove high-order zeros. 
BEGIN 
LOCAL 
SCAN_DONE 
SCAN” COUNTER; 
SCAN_COUNTER = 0; 
SCAN_DONE = 0; 


DO 
BEGIN 


IF (.SCAN_COUNTER GEQ .RESULT_DIGITS) 


SCAN_DONE = 1 
ELSE 


END 
UNTIL (.SCAN_DONE) ; 
IF (.SCAN_COUNTER GTR 0) 
THEN 


ADE HAE BEBE BS PNE FAIA IAW BBB EB PN FWA INIIInonononp 


Souk Ad 
‘— 
ow 


IF (.RBUF C.SCAN_COUNTER] EQL %C'O") THEN SCAN_COUNTER = .SCAN_COUNTER = 1 ELSE SCAN_DONE = 


1) = .SCAN_COUNTER); 


IF (.RBUF C.SCAN COUNTER] EQL %C'O") THEN SCAN_COUNTER = .SCAN_COUNTER + 1 ELSE SCAN_DONE = 
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; 76 of INCR COUNTER FROM 9 TO .RESULT_DIGITS = .SCAN_COUNTER = 1 DO 
3 a RBUF C.COUNTER] = .RBUF C.COUNTER + .SCAN_COUNTER]; 
3 178 ? Peet pisits = ,RESULT_DIGITS = .SCAN_COUNTER; 
: 781 7 '¢ ‘ 
; 7 ¢ ig i Return the results to the caller in the C operand. 
3 f a ‘ If there are no digits left, return a single zero digit. 
; 785 6 
3; 7 7 IF (.RESULT_DIGITS EQL 0) 
a 4 THEN 
= 7 EGIN 
: 4789 $4 -CSIGN = 0; 
; 790 1 -CEXP = 
; 791 Bee STRSCOPY R -CDIGITS, ZREF (1), ZREF (ZASCII'O')); 
; 79 88 CHK_STR_TY PE OCDIGIESCDSCSA. POINTER] REF (1),.CBIGITS); 
; 79 884 END™ 
3; 794 0885 
; 795 44] 1+ 
; 796 088 i Call CHK_STR_TYPE to determine if we need to pad the number with 
: 797 0888 i [eading zeroes depending on the string type. 
; 798 889 in 
; 799 890 
; 800 0891 ELSE 
: 801 089 BEGIN 
; 089 -CSIGN = .RSIGN; 
; 80 0894 -CEXP = .REXP; 
; 0895 CHK_STR_TYPE (.R_DESCCDSCSA_POINTER],RESULT_DIGITS,.CDIGITS); 
3; 805 0896 END; 
3 0897 
; 807 0898 ! ELSE 
: 808 0899 ! BEGIN 
; 809 0900 ! -CSIGN = .RSIGN; 
; 810 0901 ! -CEXP = .REXP; 
; «811 344 : STRSCOPY_R (. CDIGITS, RESULT_DIGITS, .R_DESC CDSCSA_POINTER]); 
; aig 838 : END; 
: 1 904 
> 814 0905 
; 815 B08 '¢ 
: 816 090 i Free our strings. 
3; 817 0908 ie 
: 18 0909 STRSFREE1_DX (R_DESC); 
3 ah 910 STRSEREE] DX (A-DESC); 
; 820 911 STRSFREE1_DX (B_DESC); 
; 821 0912 #1 END; ! end of STRSADD 


-TITLE STRSARITH 
IDENT \1-019\ 
-PSECT _STRSCODE,NOWRT, SHR, PIC,2 
O# 0000 P.AAA: .BYTE O07) 
C B88 -BYTE 1 
008 
oc 000E 


P.AAB: .BYTE  0[6) 
BYTE 1, 12 


Sete te ee 


_—————— 


00 44 44 41 24 52 54 53 


OFFC 00000 
5E BC AE YE 00002 
. & 06 
4 AE 7C 09 
. «@ oc 
6D 0401 CF ODE OF 
09 6c 91 14 
2 if 17 
24 AE 010E0007 8F OD 19 
28 AE DS AF 9E 
24 «AE OOF 
7E 6C 9A 
2 00 
DD 
4 
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694727, — NAME DESC 
P.AAE, ROUY_N AME _DEST+4 
NAME Desc. 


=(§ 
Fa 
#STRS_WRONUMARG 
ee LTBSSTOP 

A PESC 
aT DESC s2 
We. ke Of ESC+3 
ABUF 


isis, R2 
. LIBSANALYZE SDESC 
0 STA ale 


tar 1S ; 


if IBS$_INVARG 
gp eTesstor 


SADD, Save R2,R3,R4,R5,R6,R7,R8,R9,R10,- . 


SH SUUsEl atten SMeSRantz., Pe 
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7-019 1eaeee= foe $bikorty §«— eetent sae ssf eante 0 6$3.1 
14 AE 9F 00074 PUSHAB (C_LEN 
24 AC DD 00077 PUSHL coIGITS 
000000006 0 FB 7A CALLS #3, LIBSANALYZE_SDESC 
D 1 MOVL RO, STATUS 
1 D4 CMPL status, #1 
000000006 er bb 5 ate i 188 INVARG 
000000006 00 1 FB 0 F CALLS ‘1. LTBSSTOP 
16 AE D4 % 3$: CLRL A_LEN 
04 AE 04 Bt DO 0 MOVL § @ASIGN, A_SIGN 
1 04 i CLRL § SCAN_DONE 
1% 62 10 09 FD OOA 4$ CHPZV #9. #16, (R2), A_LEN 
50 08 A 14 ar gi boas ADDL3 A LEN, ABUF, RO 
3 60 91 OOOAE CMPB ss (RO), #48 
OA 1F 00081 BLSSU-5$ 
39 60 91 00083 CMPB ss (RO), -#57 
05 1A 0086 BGTRU 5$ 
14 AE D6 0008 INCL  A_LEN 
03 11 000B8B BRB 33 
51 01 DO 000BD S$: MOVL #1, SCAN_DONE 
DD 51 £9 900 6$: BLBC  SCAN_DONE, 4 
14 AE D6 000C INCL  A_LER 
3c) 0 AE. sO «00006 PUSHAB A~DESC 
18 AE OF 900¢9 PUSHAB A-LEN 
000000006 00 02 FB 6 OCC CALLS #2, STRSGET1_DX 
08 AE 40 AE 00 00003 MOVL A_DESC+4, ABOF 
56 08 AE »bO et MOVL aru. R 
66 30 20 00DC MOVE #48, (R6) 
57 146 AE o4 C3 OOODF SUBL3. #1, A_LEN, R7 
01 Ab 04 82 7 28 OO0E4 MOVC3 R7, a&(R2), 1(R6) 
04 AE Eg OOEA BLBC OA SIGN, 13§ 
50 01 OA : OOOEE MOVAB 1R7), COUNTER 
07 11 000F BRB 8$ 
6046 69 «BF 6046 83 OO0F4 7$: § (COUNTER) CR6], #105, (COUNTER) CR6] 
F6 50 F4 O00FB 8S: SOBGEQ COUNTER, 7$ 
51 D4 O00rE CLRL. CARRY_DONE 
50 57 00 001 MOVL R7, CARRY_COUNTER 
1B 19 001 BLSS si 
6046 96 00105 9$: INCB = (CARRY_COUNTER) [R6] 
39 6046 91 4 8 CMPB = (CARRY COUNTER) CR6J, #57 
05 1A 0010C BGTRU 10$ 
51 01 00 001 MOVL #1, CARRY_DONE 
6 11 0011 BRB 11§ 
6046 A 83 113 108 SUBB2 #10, (CARRY_COUNTER)(R6) 
0 v7 0011 DECL § CARRY_COUNTER 
OA 51 £8 00119 118 BLBS § CARRY-DONE, 13$ 
50 05 OO1IC TSTL ARRY~ COUNTER 
g> 1 11 BGEO 
03 1 €8 00120 12$: BLBS | CARRY_DONE, 13$ 
04 AE 04 001 CLRL  A_SIGR 
4 AE BA 1 $ 13$ CLRY OBB ESC 
ME OF 90 901 HOVE «#15, B_DESC#+2 
AE 2 90 00120 MOVB #2, B DESC+3 
38 AE p4 131 CLRL 8B bEST+ 
18 AE 9F 001 PUSHAB BBUF 
AE 9F 00137 PUSHAB B_LEN 
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1exee-13Be Pb:2hi3t = PANEAT Obiegesé Mis0-245 9 ta) 
52 18 AC 00 134 MOVL DIGITS, R2 : 
DD 001 PUSHL : 
000000006 99 FB 14 CALLS #3, LIBSANALYZE_SDESC F 
DO 0014 MOVL RO, STATUS : 
01 D4 14A CMPL sTATUS, #1 : 0539 
000000006 Sr be borer eee, Tes. INvanc : 0541 
000000006 00 1 FB 00155 CALLS ‘1, LIB$STOP ; 
1¢ AE 04 0015C 148: CLRL B_LEN + 054 
6E 10 Bf DO 0015F MOVL @BSIGN, B_SIGN 3: 054 
1 D4 163 CLRL SCAN DONE : 0549 
62 10 09 FD 165 15$: CHPZV #0, #16, (R2), B_LEN + 0554 
50 18 «OA 1¢ =AE C1 001 ADDL3 B_LEN, BBUF, RO + 0559 
3 $6 3 S195 CMPB CRO}. Ps : 
OA 1F 0176 BLSSU _16$ : 
39 60 91 0017 CMPB—s-s« (RO), #57 : 
05 1A 00178 BGTRU 16$ : 
1C aE D6 00170 INCL  B_LEN + 0561 
03 11 00180 BRB 17$ : 
51 01 vO 001 é 16$:  MOVL #1, SCAN_DONE + 0563 
DD 51 €9 00185 17$: BLBC = SCAN_DONE, 15$ : 0566 
1¢ AE D6 00188 INCL  B_LER : 0569 
34 AE 9F 0018B PUSHAB B~DESC : 0570 
20 AE 9F 0018E PUSHAB B7LEN : 
000000006 00 02 FB 00191 CALLS #2, STRSGET1_DX 3 
18 AE 38 AE DO 00198 MOVL 8 _DESC+4, BBUF + 0571 
59 18 AE 00 0019D MOVL BBUF, : 0572 
69 3 29 OO1A1 MOVE #48, (R9) : 
5B 1c OA 1 C3 O01A4 SUBL3. #1, B_LEN, R11 + 0573 
01 A9 04 8B B 28 00149 MovC3 R11, S4(R2), 1(R9) : 
3 6E E9 OO1AE BLBC =-B_SIGN, : 0575 
50 01 AB — 001B2 MOVAB 1°R11). COUNTER + 0584 
07 11 00186 BRB 19$ : 
6049 69 8F 6049 83 001B8 18$: SUBB3 (COUNTER)CR9], #105, (COUNTER)CR9J : 0585 
F6 50 F4 O01BF 19$:  SOBGEQ COUNTER, 18$ : 
51 D4 001C2 CLRL. CARRY_DONE + 0593 
50 SB o0 01C4 MOVL R11, CARRY_COUNTER 3 0594 
1B 19 001C7 BLSS 23$ : 0596 
6049 96 oic9 20$: —*INCB (CARRY COUNTER) ER9J : 0601 
39 6049 91 001CC CMPB = (CARRY-COUNTER)CR9J, #57 + 0603 
5 1A 0010 BGTRU 21$ : 
51 i 00 001D MOVL #1, CARRY_DONE > 0605 
6 11 0010 BRB ec : 
6049 A be 107 21$:  SUBB2 #10, (CARRY_COUNTER)CR9) > 0608 
0 07 00108 DECL  CARRY_COUNTER ; 0609 
09 1 £8 001DD 228:  BLBS | CARRY“DONE, 248 : 0613 
50 D5 OO1E TSTL CARRY COUNTER ; 
£3 18 OO1E BGEQ 0 : 
02 1 £8 OO1E4 23$:  BLBS § CARRY_DONE, 24$ > 0615 
6E 04 OO1E7 CLRL 86 SIGN : 
50 08 ¢ DO OO1E9 24%:  MOVL $a@AEXP, RO > 0624 
16 BC D1 10 CMPL RO aBEXP : 
4 1F1 BLEG § ; 
59 14 B D 13 MOVL EXP, RO : 
DO OO1F7? 25%:  MOVL RO, REX : 
50 08 BC 16 AE C1 OO1FA ADDL3 A_LEN, @AEXP, RO : 0630 
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1077 bytes, 
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STRSARITH 16-5¢ Sep-1 AX-11 Bliss-32 V4.0-74 Page 23 R 
1-019 mH ety 93: 25:3 LIBRTL.SRC STRANTTH.03951 . 3} Q 
: 4 914 1 GLOBAL ROUTINE STRSMUL ( ! Multiply two etrin s | 7) 
895 915 1 ASIGN, i S454 rors rand Av | 
3 § 318 1 AEXP : Decinal Se enent of operand A . 4 
; 917 1 ADIGITS, i Digits of operand A iy 
§ 3 918 1 BSIGN, ! Sign of operand . 4 
3 919 1 BEXP : Bye jeet exponent of cperand B . 4 
: 830 920 1 BDIGITs, i Digits of operand a 
; 1 921 1 CSIGN, ' Sign of operand C . 4 
3 § 9 § 1 CEXP ! Decimal exponent of operand C¢ 24 
; 923 1 CDIGITS i Digits of operand C sf 
; 904 1 ) : NOVALUE = : 
: 836 3eo 1 its 7. 
3 ‘ 09 5 ! FUNCTIONAL DESCRIPTION: ; 4 
; 839 0929 1! Multiply two decimal numbers. C :=A* 8 : 1 
; 840 0930 1! : 1 
; 841 0931 1 | FORMAL PARAMETERS: 7] 
> 84 0938 1 | :] 
3 84 0933 1: ASIGN. ever 0 = operand A is positive, 1 = negative i] 
> 844 0934 1: AEXP.r lor Power of 10 by which to multiply the operand A :] 
; 845 0935 1! digits to get bigs soseiute ¥3 ue of operand A. : 1 
; B46 0936 1! E.g., AEXP = 1, 123 gives 1 :] 
; 847 0937 1! ADIGITS.rnu.d Descriptor for’ the ‘digits of of operand A i] 
; 848 0938 1! BSIGN.rv.r 0 = operand B is positive, 1 = negative i] 
; 849 0939 1! BEXP.rl.r Power of 10 by which to multiply the operand B 7) 
: 850 0940 1! digits to get che speoiute value of opgrand B. : 1 
; 851 0941 1! E.g., BEXP = -1, BDIGITS = le gives i] 
; 832 094¢ 1 BDIGITS.rnu.d Descriptor for the d digits of of operand B i] 
; 85 0943 1! CSIGN.wl.r 0 = operand C is positive, 1 = negative : 1 
; 854 0944 1 | CEXP.wl.r Power of 10 by which to multiply the operand C : 1 
: 855 0945 1! digits to poet ‘the absolute yalue of operand C. : 1 
; 856 0946 1! E.g., CEXP = 0, CDIGITS = 123 gives 123. :] 
3 tH aad CDIGITS.wnu.d Descriptor for the digits of operand C : : 
; 859 0949 1 | IMPLICIT INPUTS: 7] 
; 860 0950 1! 7] 
; 861 0951 1! NONE :] 
; 862 0938 1! i] 
; 86 0953 1! IMPLICIT OUTPUTS: :] 
3 He 0954 1} : 1 
; 865 0955 1! NONE 7] 
; 866 0928 1! 1 
; 867 099 1 | ROUTINE VALUE: i] 
; 8 958 1 | COMPLETION CODES: : 
; 869 0999 1} 21 
; 870 960 1! NONE : 1 
3; 871 0961 1! : 1 
; i 962 1 | SIDE EFFECTS: 3 7 
; 87 963 1! : 1 
; 874 964 1 | May allocate space for the CDIGITS string. | 
; 875 965 1! Signals if storage is exhausted. :] 
$ 16 206 1 i- g 1 
; 87 967 1 : 1 
; 878 208 BEGIN : 
: 879 9 3 1 
; 880 970 MAP : 1 
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ARITH.B 


3 $ 971 ADIGITS : REF BLOCK (8, BYTE), 

3 ¢ He BDIGITS : REF BLOCK (8, BYTE), 

g 4 CDIGITS : REF BLOCK (8, BYTE); 

; H 5 975 LOCAL 

3 4 376 '¢ 

: 88 97 ' Internal form of A. 

; 888 44 != 

; 889 097 A_DESC : BLOCK (8, org VOLATILE. 
: 890 0980 ABUF : REF VECTOR (65535, BYTEJ, 

; 891 0981 ALLEN, 

3 £36 9 ¢ A_SIGN, 

3 9 9 '+ 

3 94 984 ! Internal form of B. 

; 895 Boge l= 

; 896 Hy B_DESC : BLOCK (8, orTg2 VOLATILE, 
3 97 098 BBuF : REF VECTOR (65535, BYTE], 

: 898 0988 B_LEN, 

: 899 0989 B_SIGN, 

; 900 0990 1+ 

; 901 0991 ' Local copy of result. 

3 a08 099 ad 

; 90 099 RSIGN, 

; 904 0994 REXP 

: 905 0995 R_DESC : BLOCK C8, BYTE VOLATILE, 
; 906 0996 RBUF : REF VECTOR (65535, BYTEJ, 

: 907 0997 R_LEN, 

; 908 0998 

; 909 0999 '¢ 

3 ai9 1390 The following are locals for the call to LIBSANALYZE_SDESC. 
3 alg 100 CBUF, 

; 91 100 C_LEN 

> 914 1004 STATUS; 

; 915 1005 

; 916 1006 BUILTIN 

; 917 1007 ACTUALCOUNT; 

:; 918 1008 

; 919 1009 '¢ 

3 35¢ 1919 Enable a handler to free the local strings in case of an error. 
; 9 ¢ ols 

3; F 101 ENABLE 

3 924 1014 FREE_STRINGS (A_DESC, B_DESC, R_DESC); 
: 925 1015 

3; 9 § 1918 '¢ 

3; F 101 ! Check the number of arguments. 

: 928 1018 le 

; 363 1019 

3 18 ’ IF (ACTUALCOUNT () LSS 9) 

3 $3 10 § BEGIN 

: 3 19 & LOCAL 

; 935 1025 

3; 9 19 § 

3; 9 1 ROUT_NAME_DESC CDSCS$W_LENGTH) = 7; 


ROUT_NAME_DESC : BLOCK (8, BYTE); 
| 
| 
| 
| 
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1 ~3007 138% 94:20:81 LIBRTL.SRCISTRARITH.B3 31 
R_DESC DSC$B_DTYPE] = DSCSK_DTYPE_NU; 
R-DESC [DSC$B-CLASS) = DSCSKICLASSD; 
R Dest DSCSA POINTER] = 6; 
STRSGET1_DX (SREP (1), RDESC); 
RBUF = .R DESC DSCSA POTNTERI; 
R_LEN = -R_DESC DSC$Q_LENGTHI: 
RBUF (0) ="XC'O'; 
RSIGN = 0; 
REXP = 0; 


4 

! Go earoug? each digit of B, adding appropri 
! R the indicated number of times. This is | 
adding machines. 


ately shifted A to 
ike the old mechanical 


INCR POS FROM 0 TO .B_LEN = 1 DO 
BEGIN 


LOCAL 
DIGIT; 


DIGIT = .BBUF C(.B_LEN = 1) = .POS); 


DECR COUNTER FROM .DIGIT TO %C'1" DO 
STRSADD (ZREF (0), POS, A_DESC, RSIGN, REXP, R_DESC, RSIGN, REXP, R_DESC); 
END; 
t+ 
Compute the exponent and sign of the result. 


REXP = .REXP + (..AEXP + ..BEXP); 
RSIGN = (IF (.A_SIGN EQL .8 SIGNS THEN 0 ELSE 1); 


1+ 
' Return the result to the caller. Because it is the output of STRSADD 
it is already in normal form. 


-CSIGN = .RSIGN; 
~CEXP = .REXP; 


'¢ 


i Call CHK_STR_TYPE to determine if we need to pad the number with 
leading zeroes depending on the string type. 


R_LEN = .R_DESCCDSCSW_ LENGTH); 
CAK_STR_TYPE (.R_DESCEDSCSA_POINTER],R_LEN, .CDIGITS); 


t, STRSCOPY_DX (.CDIGITS, R_DESC); 

: Free our strings. 

" STRSFREE1_DX (R_DESC) 
STRSFREE1_DX (A DESC): 


STRSFREE1_DX (B-D ; 
END; ' end of STRSMUL 


ee : 


0551 -BLKB 
00 4C 55 4D 26 52 54 53 Eee P.AAF: ASCII \STRSMUL\<0> 
OFFC 00000 ENTRY STR 
B 000000006 00 9 902 MOVAB STRSGET1_DX, R11 
A 00 G 8F p 990 MOVL #LIB$_INVARG, R10 
9 G 0 E 19 MOVAB LIBSARALYZE_SDESC, R9 
38 00000006 9E 0001 MOVAB LIBSSTOP, RB 
E 4 AE 3 001 MOVAB =76(SP), SP 
4 AE 7C 99 CLRQ R_DESC 
C AE 7C 00 CLRQ B-DESC 
44 AE 7C 00028 CLRQ AWDESC 
6D 0109 CF OE 00 MOVAL 17$, (FP) 
0 6C 91 000 CMPB. ss APS, «#9 
iE te 000 BGEQU 1$ 
3c AE 010E0007 8F D 99035 OVL § #17694727, ROUT_NAME_DESC 
OQ AE B8 AF 9E 00030 VAB_ -P.AAF, ROUT_NAME_DEST+4 
2C AE OF 90042 PUSHAB ROUT_NAME DESC 
7E 6C 9A 0004 MOVZBL (AP)7 -(SP) 
02 DD 00048 SHL #2 
000000006 8F DD 0004A PUSHL #STR$_WRONUMARG 
68 04 FB 90050 CALLS #4, LYBSSTOP 
44 AE B4 00053 18 CLRW DES 
46 AE OF 90 00056 MOVB #15, A_DESC+2 
47 AE 02 90 0005A MOVB #2, A_BESC+ 
48 AE 04 90055 CLRL A_bESC+ 
04 AE 9F 00061 PUSHAB ABUF 
14 AE OF 90064 PUSHAB A_LEN 
52 0C AC 00 00067 MOVL ADBIGITS, R2 
52 DD 00068 PUSHL R 
69 FB 90060 CALLS #3, LIBSANALYZE_SDESC 
4 0 pC 000 9 MOVL RO, STATUS 
01 36 D1 0007 CMPL STATUS, #1 
0 13 007% BEQL 2$ 
A oD 907 PUSHL R10 
68 01 FB 7A CALLS #1, LIBSSTOP 
08 AE 9F 00070 28 PUSHAB CBUF 
10 AE OF 09 PUSHAB C_L 
24 AC ODD PUSHL coIGiTS 
69 FB 00 CALLS #3, LIBSANALYZE_SDESC 
56 DO 000 MOVL RO, STATUS 
01 : D1 C CMPL status, #1 
g 13 F EQL $ 
A oD | PUSHL R10 
68 01 FB 0009 CALLS #1, LIBSSTOP 
10 AE 04 00096 38: CLRL 
57 04 C DO 404 MOVL @ASIGN, A_SIGN 
1 04 00090 CLRL  SCAN_DONE 
10 AE 62 10 09 F 6 OF 4$ CMP2v #0, #16, (R2), A_LEN 
a3 BEQL 
50 04 AE 10 AE Ci OOOA ADDL3 A_LEN, ABUF, RO 
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SCAN_DONE 
N DONE. 4$ 


N 
STRSGET1_DX 

5C+4 F 

N a4(R2), @ABUF 


S, #1 


IBSSTOP 
N, B_SIGN 

ON 

#6, (R2), B_LEN 


ore CO Pe 2 


L 
EN 
IG 


OonRn 
eon 
2 
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#1, SCAN_DONE 

SCAN_DONE, 8$ 

B_DESC 

B-LEN 

#2, STRSGET1_DX 

B_BESC+4 
LEN, @4(R2), @BBUF 


yp et et oe 
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Pree 


STRSARITH 16-Sep-1984 01:27:51 AX-11 Bliss-32 V4.0-74 
1-019 14- ats yi 9332553] LIBRTL.SRCIJSTRARITH.B32;1 
1¢ AE 7C 00169 CLRQ REXP 
24 «AE 1 f MNEGL #1, POS 
50 18 «OA 24 AE C3 00172 118: UBL 3 POS, B_LEN, RO 
5 Le § 17 ADDL U 
& FF A oA v7 MOV ZBL -1(RO), DIGIT 
34 AE OF 00182 128 PUSHAB R_DESC 
$ AE 9F 001 PUSHAB REXP 
AE 9F 001 PUSHAB RSIGN 
40 AE 9F 001 PUSHAB R_DESC 
C AE ar 13 PUSHAB REXP 
4 AE 9F 001 PUSHAB RSIGN 
C AE OF 00194 PUSHAB A_DESC 
40 AE 9F 00197 PUSHAB POS 
20 AE D4 0019A CLRL 3 (SP) 
0 AE 9F 90190 PUSHAB %32(SP) 
FAIB. CF 9 FB O1A0 CALLS #9, STRSADD 
3 D7 OO1A DECL | COUNTER 
31 52 OT 00147 13$:  CMPL COUNTER, #49 
06 18 O1AA BGEG 12$ 
co 6 A 18 AE F2 OO1AC 14$:  AOBLSS B LEN, POS, 11$ 
50 8 BC 14 BC C1 001B ADDL3 @BEXP, @AEXP, RO 
1¢ AE 50 ¢€O 0018 ADDL2 RO, REXP 
56 57 01 001BC CMPL  A_SIGN, B_SIGN 
04 12 001BF BNEG 15$ 
50 D4 doic} CLRL = RO 
03 11 001C3 BRB 16$ 
50 01 pO 001C5 15$:  MOVL #1, RO 
20 AE 50 DO 001C8 16$:  MOVL RO. RSIGN 
1c BC 20 AE D6 O1cCc MOVL RSIGN, @CSIGN 
20 BC 1¢ AE p 0101 MOVL REXP, @CEXP 
28 AE 34 AE 3C 00106 MOVZWL R_DESC, R_L 
24 AC DD 001DB PUSHL CBIGITS 
2 «AE OF OO1DE PUSHAB R_LEN 
40 AE OD OO1E1 PUSHL R7DESC+4 
0000v CF 03 FB poTES CALLS #3, CHK_STR_TYPE 
34 AE 9F OO1E9 PUSHAB R_DESC 
000000006 00 01 FB Qiet CALLS #1, STRSFREE1_DXx 
44 AE 9F OOTF PUSHAB A_DESC 
000000006 00 01 FB 001F6 CALLS #1, STRSFREE1_DXx 
3c 0 AE. sO9F «<OOTFD PUSHAB 8B DESC 
000000006 00 01 FB 00 CALLS #1, STRSFREE1_DX 
008 8 17$: WORD sexe nothing 
50 8 AC D 0 A MOVL (AP), RO 
0 ce p MOVL  4(RO). RO 
£8 AO 9F 0021 PUSHAB R_DESC 
FO AO 9F 0021 PUSHAB B DESC 
F AQ 9F 0021 PUSHAB A~DESC 
g DD 00218 PUSHL 4&3 
E bp 1D PUSHL SP 
7E 04 AC 7D OO21F MOV. 4(AP), -(SP) 
0000v CF 03 FB 33 CALLS #3, FREE_STRINGS 
04 RET 


; Routine Size: 553 bytes, Routine Base: _STRSCODE + 055C 
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| 
| 

NONE 
IMPLICIT OUTPUTS: 
NONE 
ROUTINE VALUE: | 
COMPLETION CODES: | 
NONE 
SIDE EFFECTS: | 
May allocate space for the CDIGITS string. | 
| 


Signals if memory is exausted. 
Signals Division by zero if operand A is zero. 
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' 
' 
' 
i IMPLICIT INPUTS: 
i 
4 


| 
37 1111 1200 1 GLOBAL ROUTINE STRSRECIP ( ! {eke the reciprocal of a string 
3 1316 1201 1 ASIGN, ! Sign of operand A 
3 111 1 § 1 AEXP ' Decimal exponent of operand A 
: 1114 1 1 ADIG{TS, i Digits of operand A 
3; 1115 1204 1 BSIGN, ' Sign of operand B 
3 1118 1 82 1 BEXP : Bec imal exponent of operand B 
: 111 1 6 1 BDIGITS, i Digits of operand B 
; 1118 1207 1 CSIGN, ' Sign of operand C 
: 1119 1208 1 CEXP i Decimal exponent of operand C | 
> 1120 1209 1 CDIGITS i Digits of operand C 
: 1121 1210 1 ) : NOVALUE = 
311 g 1211 1 
3 11 1212 1 S44 
; 1 : ! 5 } : FUNCTIONAL DESCRIPTION: | 
: 1 $ : 2 : Take the reciprocal of A, to precision B. C := 1/4 
; 1; : ! 4 ! ! FORMAL PARAMETERS: 
; 1130 1219 #1 ASIGN. rv. 0= operand A is positive, 1 = negative 
3 1131 1220 1 AEXP. rll Power of 10 by which to multiply the operand A 
3; 13 4 1221 1 digits to get the absolute ¥3 ue of gearene A. 
3 171 1 ; 1 E.g., AEXP = 1, ADIGITS = 125 gives 1230. 
3: 1134 1 1 ADIGITS.rnu.d Descriptor for the digits of operand A 
3:11 1224 1 BSIGN. rv. 0 = operand B is positive, 1 = negative 
3 11 1225 1 BEXP.rl.r Power of 10 by which to multiply the operand B 
3; 71 1226 1 digits to get the absolute value of operand B. 
3 11 1227 1 ne = -1, BDIGITS = 123 gives 12.3. 
3 11 1228 1 BDIGITS.rnu.d Descriptor for the digits of operand B 
3 11 1229 1 CSIGN.wil.r 0= apecend C is positive, 1 = noges tee 
3 11 \§ 0 1 CEXP.wl.r Power of 10 by which to multiply the operand C 
3 1) 1231 1 digits to get the absolute ¥3 ue of opgrand €. 
7171 12 ¢ 1 E.g.. CEXP = 0, CDIGITS = 123 gives 123. 
3 i i ? : CDIGITS.wnu.d Descriptor for the digits of operand C 
: 11 1235 1 
3 11 Is 6 1 
311 1 1 
3 11 12 1 
: 11 1 1 
3 11 1 1 
3 11 1 1 
3°11 1 1 
3 (11 1 1 
3 11 1 1 
3 11 1 1 
3 11 1 1 
s 11 1 1 
311 1 1 
¢ 11 1 1 
311 1 1 
311 1 1 
3 11 1 1 
3 11 1 1 
» FF 1 1 
311 1 1 
3: 11 1 2 
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Now see if we are close enough to the reciprocal. 


STRSMUL (Q_SIGN, Q_EXP, Q DESC, ' 
ZREF (0), .AEXB, A DESC i 
A_SIGN, XA_EXP, XK DESC); 
A’SIGR, XA_EXP, XA_DESC, ! 
1 (0), ONE_BESC, i 
SIGN, DELTA_EXP, BDELTA.DESC); 


ELTA_SIGN, DELTA_EXP, DELTA_DESC, 


F 
1), 7BEXP, 
N, X2_EXP, X2_DESC); 


IF (.X2_SIGN) 
N 


ITER_DONE = 1 
ELSE 


IF (.DELTA_DESC COSC$W_LENGTH] EQLU 1) 
BEGIN 
LOCA 


a-c02) -—x 


END; 
END 
ELSE 
BEGIN 
STRSADD (Q SIGN, Q_EXP, Q DESC, 
XREF (0), POS, ONE DESC, i 
i Q_SIGN, G_EXP, Q_DESC); 


END 
UNTIL (.ITER_DONE); 
+ 
} original sign of A, which was not used above. 


-CSIGN = .A_SIGN; 
-CEXP = .Q_EXP; 


'¢ 


leading zeroes depending on the string type. 
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QLEN = .Q DESCCDSCS$W petty 
CHK_STR_TYPE (.Q_DEST DSC$A_POINTER],QLEN, .CDIGITS); 


16-Sep-1984 01:27:51 
1$-$e0-19 4 93:25:31 


L 

DELTA_BUF : REF VECTOR (65535, BYTE); 
DELTA_BUF = .DELTA_DESC CDSCSA_POINTER); 

IF (.DELTA_BUF CO] EQL %C'O*) THEN ITER_DONE = 1; 


! The reciprocal now lives in Q. Return it to the caller with the 


i Call CHK_STR_TYPE to determine if we need to pad the number with 


=32 V4.0-74 
STRARITH.B32;1 


35 
STRARITH.B32;1 
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! end of STRSRECIP 
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13 
ibese =1984 01:27:51 AX-11 Bliss-32 V4.0-74 Page 40. 
127808-1 3b tart LIBRTL.SRCISTRARITH.B3 31 . -) 
000000006 af DD 00087 PUSHL #LIBS$_INVARG : 1360 : 
9 1 FB CALLS #1, LYBS$STOP : F 
OC AE 3F 2$ PUSHAB (BUF + 1367 ; 
My, At BD 3 pus é aie : 
000000006 90 5 FB $98 CALLS a LIBSANALYZE_SDESC : ; 
6 D Ap MOVL TATUS : ; 
01 8 D4 A CPL TATUS, #1 : 1368 ; 
000000006 rf DD Ona PUSHL #18 INVARG : 1370 : 
69 1 FB OOAE CALLS #1, LYBSSTOP : ; 
14 AE D4 00081 38 CLRL = ALLE ; 137 ; 
57 04 BC DO 000B4 MOVL § @ASIGN, A_SIGN : 137 ; 
1 04 00088 CLRL § SCAN_DONE : 1379 
AE 62 10 09 FD OOBA 4$ CMP ZV #0, #16, (R2), A_LEN + 1384 
50 08 A 14 AF gi aot ADDL3 A LEN, A_BUF, RO + 1389 
3 60 91 000C CMPB =Es« (RO), #48 : 
OA 1F 000CB BLSSU -5$ ; 
39 60 91 000CD CMPB =s-« (RO), -#57 : 
05 1A 00000 BGTRU 5$ ; 
14 AF D6 90008 INCL  A_LEN + 1391 
03 11 0000 BRB 6$ ; 
51 01 DO 00007 5$ MOVL #1, SCAN_DONE + 1393 
DD 51 f OOODA 6$ BLBC SCAN_DONE, 4$ 3: 1396 
8 AD F Bence PUSHAB A_DESC 3; 1399 
18 AE OF OOE0 PUSHAB A-LEN ; 
68 02 FB OOOE CALLS #2, STRSGET1_DX 3 
08 AE FC AD DO OO0E6 MOVL.  A_DESC+4, A_BUF + 1400 
08 BE 04 B2 14 AE 28 OO0EB MOVC3 A“LEN, a4(R2), @A_BUF : 1401 
AE 30 FFOS CF 01 2D 000F CMPCS5 «#7, P.AAH, #48, AULEN, @A_BUF + 1406 
08 6E OOOFA ; 
09 12 O00FC BNEQ = 7$ ; 
000000006 1 8F DD OOOFE PUSHL #STR$_DIVBY_ZER F 
69 01 FB 00104 CALLS #1, LYBS$STOP ; 
FO AD B4 00107 7$ CLRW B_DESC + 1408 
F2 AD OF 90 0010A MOVB #75, B_DESC+2 + 1409 
F3 AD 02 90 01 MOVB #2, B_BESC+ + 1410 
F4 OAD p4 011 CLRL B_DEST+4 + 1411 
18 AE 9F 0011 PUSHAB B~BUF + 1419 
20 AE 9F 00118 PUSHAB B”LEN ; 
52 18 AC DO O18 L  BBIGITS, R2 ; 
52 DD O011F PUSHL R : 
000000006 90 9 FB 121 CALLS #3, LIBSANALYZE_SDESC : 
6 DO 00128 MOVL RO. STATUS ; 
01 56 D1 00128 CMPL = STATUS, #1 : 1420 
09 13 001 BEQL Ss«B ; 
000000006 18F DD 001 PUSHL #188 INVARG > 1422 
69 01 FB 001 CALLS #1, LYBSSTOP : 
\f AE 04 1 8% CLRL B_LEN : 1423 
50 1 Bt DO 001 MOVL § a@BSIGN, B_SIGN + 1404 
1 04 0014 CLRL = SCAN > 1430 
AE 62 10 09 ig 14 9$ cCHPZV ' { Wi6, (R2), B_LEN > 1435 
50 18 «OA 1C ar § 14A ADDL3 B LEN, B_BUF, RO > 1440 
3 60 91 130 CMPB ss (RO), #48 : 
OA 1F 001 BLSSU -:10$ ; 
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m1 
STRSARITH 16-Sep-1984 01:27:51 AX-11 Bliss-32 V4 0-742 Page 44 31 
1-019 14-Sep-1984 12:40:01 LIBRTL.SRCJSTRARITH.B32; 1 (6) 
6A 01 FB 9 CALLS #1, STRSFREE1_Dx ; 
04 ¢ RE : 1810 
00 18$: - WORD sexs nothing 3 1256 
50 08 AC D MOV (AP), ; 
50 4 A MOVL  4(RO), R ; 
C8 «AO OF : PUSHAB DELTA DESC : 
D0 AO OF A PUSHAB XA_DESC : 
D8 AO 9F 0039 PUSHAB Q_DBESC : 
EQ AO 9F OO3A PUSHAB X2_DESC ; 
E8 AO 9F OO3A PUSHAB X_DESC ; 
FO AO 9F OO3A PUSHAB B_DESC : 
FB =AO OF OO3A PUSHAB A-DESC ; 
9 DD OO3AC PUSHL 4&7 ; 
£ bb A PUSHL SP ; 
7E 04 At D 0038 MOVa 4(AP), (SP) : 
0000v CF 03 FB 00384 CALLS #3, FREE_STRINGS : 
04 00389 RET ; 


; Routine Size: 954 bytes, Routine Base: _STRSCODE + 0798 


; 1522 1611 1 


le ire 4 


N 13 
STRSARITH 16-Sep-1984 01:27:51 AX-11 Bliss-32 V4.0-74 Page 45 
1-019 12-308718 4 Pt pet LIBRTL. SRCISTRARITH.B3 31 ’ (7) 
>: 1526 1oi¢ 1 GLOBAL ROUTINE STRSROUND ( ' Round a number 
; 1525 1615 1 PLACES, ! Max decimal places in the result 
3 7 $ 1614 1 TRUNC, ' Truncate to that many places 
3; 3 1615 1 ASIGN, ! Sign of operand A 
; 1528 19i8 1 AEXP ' Decimal exponent of operand A 
: 1529 1617 1 ADIGITS, i Digits of operand A 
; 1550 1918 1 SIGN, ! Sign of operand B 
3; 15351 161 1 EXP ' Decimal exponent of operand B 
:1 é 1620 1 BDIGITS i Digits of operand 
3 1 1621 1 ) : NOVALUE = 
3 15 16 § 1 
; 1 5 16 1 !¢¢ 
: 12 My : : FUNCTIONAL DESCRIPTION: 
; 1338 16 $ . § Round or truncate a number to a specified number of significant 
; 1539 16 1! digits. 8 := ROUND (A) 
3; 1540 1628 1! 
3 1363 + 9 ! FORMAL PARAMETERS: 
3 1808 1651 1! PLACES.rl.r Max decimal digits to retain in the result 
3 15446 1o34 1! TRUNC rv. = round, 1 = truncate to that many places 
3; 1545 1635 1! ASIGN.rv.r = operand A is positive, 1 = neget ve 
3; 1546 1634 1! AEXP.rl.r Power of 10 by which to multiply the operand A 
3 1547 1635 1! digits to get the absolute ya ue of operand A. 
: 1548 1636 1! E.g., AEXP = 1, ADIGITS = 125 gives 1230. 
3; 1549 16357 1! ADIGITS.rnu.d Descriptor for the digits of operand A 
: 1550 1638 1! BSIGN.wil.r 0 = operand B is positive, 1 = aeget ive 
; 1551 1639 1! BEXP.wil.r Power of 10 by which to multiply the operand B 
: 1328 1640 1! digits to get the absolute value of operand B. 
3; 155 1641 1! E.g., BEXP = -1, BDIGITS = 123 gives 12.3. 
; 1328 bo | ! BDIGITS.wnu.d Descriptor for the digits of operand B 
: 1556 1644 1°! IMPLICIT INPUTS: 
3; 1557 1645 1! 
; 1558 1646 1! NONE 
3; 1559 1647 1! 
; 1560 1648 1°! IMPLICIT OUTPUTS: 
3; 1561 1649 1! 
3 1206 1650 1! NONE 
3; 156 1651 1! 
3 1564 1636 1 ! ROUTINE VALUE: 
3; 1565 1655 1 ! COMPLETION CODES: 
3 1366 1654 1! 
3; 156 1655 1! NONE 
3; 1568 1908 1! 
3 1288 1657 1 ! SIDE EFFECTS: 
; 1570 1658 1! 
3; 1571 1659 1! May allocate space for the BDIGITS string. 
; 1378 1660 1! Signals if memory is exhausted. 
3 157 1661 1! 
3 1574 1996 1 !-- 
3; 1575 1665 1 
; 1278 1664 BEGIN 
3; 157 1665 
: 1378 1998 MAP 
3 157 166 ADIGITS : REF BLOCK fe. evted- 
3; 1580 1668 BDIGITS : REF BLOCK (8, BYTE); 
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1-01 14 ats 7 93: 20%8y LIBRTL-SRCISTR ; ™ 
of significant digits. 
RESULT_DIGITS = .R_LEN; 
IF (.RESULT_DIGITS GiR ..PLACES) 
THEN 
BEGIN 
IF ( NOT ..TRUNC) 
THEN 
*e BEGIN 
i Check the highest-order digit we will discard. If it is five or 


: erger. round up. Note that the number is in sign-magnitude form 
at this point, so rounding ‘‘up"’ 


Se 


is always away from zero. 


IF (-RBUF C..PLACES] GEQ %C¢'5") 
BEGIN 
OCAL 
CARRY_ COUNTER, 
CARRY “DONE ; 
CARRY_DONE = 0; 


CARRY_COUNTER = ..PLACES = 1; 
IF (.CARRY_COUNTER GEQ 0) 
THEN 


Do 
BEGIN 
RBUF C.CARRY_COUNTER] = .RBUF C.CARRY_COUNTER] + 1; 
IF (.RBUF C.CARRY_COUNTER] LEQ %C¢'9") 
CARRY_DONE = 1 
SE 


BEGIN 
RBUF C.CARRY COUNTER] = .RBUF C.CARRY_COUNTER] - 10; 
CARRY, SOUNTER = .CARRY_COUNTER = 1; 


END 
UNTIL ((.CARRY_DONE) OR (.CARRY_COUNTER LSS 0)); 
IF ( NOT .CARRY_DONE) 
THEN 
a BEGIN 
i The carry has forced a right shift (all 9's rounded up). 
! We are guaranteed enough Space since we must be dropping at least 


! one digit. Because of this shift we must now be dropping at least 
} two digits. 
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s 3 
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ie 1 
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31539 oreo 8Re Pb: ehi8t | ete etde ste anti 635.1 age 30 
0852 .BLKB) 2 
00 00 00 46 4E 5S GF 52 26 $2 56 53 OopSe P.AAI: ake er  <stRSROUND\<0><0><0> , 


2 
° { 
° { 
: 
OFFC 00000 ENTRY STRSRO ND, Save R2,R3,R4,R5,R6,R7,RB,R9,- : 
58 900000006 0 9E 0000 MOVAB LIBS$ANALYZE_SDESC, R11 : 4 
5a 000000006 00 H 000 MOV LIBSSTOP, RTO : 3 
5E 0 g 0019 SUBL2 #48, SP : : 4 
28 AE 7C 0001 CLRO. =- R_DES ; z 
60 016C «CF DF 0016 MOVAL 17$, (FP) : z 4 
8 6C 1B CMPB. ss (APS, #8 : 24 
iE 3 OO1E BGEQU 1$ : 4 
30 AE 010E0009 8F OD 90 MOVL § #17694729, ROUT_NAME_DESC ; 3 
4 AE C9 «AF SE 00028 OVAB PAL. ROUT_NAME_DEST+4 : zs 
20 AE 9F 00020 PUSHAB ROUT_NAME_DESC : 3 4 
7E 6C 9A 000 9 MOVZBL (AP)> =(SP) : zs 
02 Dd 000 PUSHL #2 ; 3 
000000006 8F DD 00035 PUSHL #STR$_WRONUMARG ; 3 
6A 04 FB 0038 CALLS #4, LIBSSTOP : : 4 
59 0¢ BC dO 000 : 1$: MOVL te A_SIGN ; 3 4 
58 10 BC DO 0004 MOVL aAeX "RERP : 3 
28 AE B4 00046 CLRW : 2 
2A OE OF 90 00049 MOVB arse sR DESC+2 ; 4 
2B OA 02 90 00040 MOVB #2, R_BDESC+3 ; 24 
2C «AE D4 00051 CLRL R best’ +4 $ 2 4 
08 AE 9F 00054 PUSHAB : 24 
10 AE 9F 00057 PUSHAB A_LEN : 34 
52 14 AC DO OO05A MOVL  ADIGITS, R2 ; : 4 
3¢ DD 0005 PUSHL R : 34 
68 03 FB 0006 CALLS ’ LIBSANALYZE _SDESC : 3 4 
53 20 DO 0006 MOVL RO. STATUS : 34 
01 53 D1 00066 CMPL _—s STATUS, rt : 24 
09 «13 90069 BEQL 2 : 34 
000000006 8F DD 00068 PUSHL #L1BS INVARG : 34 
6A 01 FB 00071 CALLS a id 3 3 4 
10 AE 9F 00074 2$: PUSHAB 3 3 4 
18 AE 9F 00077 PUSHAB : 34 
57 20 AC DO 0007A OVL BaLEN R7 : 34 
57 DD 0007E PUSHL : 34 
68 03 FB 9080 CALLS #3, LIBSANALYZE_SDESC : 24 
: g DO 000 MOVL * STATUS : 34 
01 5 Dt 99 CMPL US, #1 : } 
9 1 BEQL : FF 
000000006 8F DD 0008B PUSHL aL 188 IN INVARG : 24 
6A 1 FB 00091 CALLS STOP ; ¥ 
18 AE D4 00094 3S: CLAL E ; 34 
51 D4 97 CLRL SCAN_DONE : 3 
18 AE 62 10 09 FD 0099 4$: CMPZ7v #0, #16, (R2), R_LEN ; 
1 009F EQL=SséSS : 
50 08 A 18 AF ci OOA1 ADDL3 R_LEN, ABUF, RO ; 
3 6 1 0 A7 CMPB =s-« (RO) , #48 : 
A 1F QOOAA BLSSU5$ ; 
39 60 91 OOOAC CMPB ss (RO), _-#57 : 
1A OOOAF BGTRU 5$ ; 
18 AE 06 00081 INCL  R_LEN : 
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30 AE 9F 0179 PUSHAB RESULT_DIGITS ; 

4 AE DD 0017 PUSHL R_DESC?4 ; 
aaaél 28 ke oF Ole | fusta Aber 1891 
000000006 00 01 FB O17 CALLS #1, STRSFREE1_Dx ; sons 
0000 O18 17$ «WORD Save nothing + 1664 

50 AC DO 001 MOVL BC(AP), RO : 

PB OAD OF 09196 PUSHIAR RebESe 

1 DD 0019 PUSHL #T : 

E pp 0198 PUSHL SP ; 

7E 04 AC 7D 0019 mova.  4(AP), =(SP) : 

0000v CF 0 FB 0198 CALLS 3, hee. _STRINGS : 


; Routine Size: 417 bytes, Routine Base: _STRSCODE + 0860 


; 1806 1894 1 
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GLOBAL ROUTINE STRSDIVIDE ( 
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! Sign of operand A 

' Decimal exponent of operand A 

! Digits of operand A 

Sign of operand 

' 


8 
Decimal exponent of operand B 
' Digits of operand 
'\Number of Te'ss to the right of the 
'/decimal point to carry out the divide 
' Round/Truncate parameter 
' To contain sign of operand C 
' To contain dec {mal exponent of operand C 
! To contain digits of operand C 
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12-80-1382 3 40:01 YOMBRIL SREISTRANTTN.O3951 . 3 
: ++ 
FUNCTIONAL DESCRIPTION: 
i This routine finds the quotient of two decimal strings i.e. C=A/ 8B. 
! The algorithm implemented here has been provided by KNUTH. It is 
! his famous Algorithm D (division of non-negative integers (which has 
! been modified to handle negative integers)) found in Volume 2 of 
! that extraordinary series (Vol. 2 is entitled Seminumerical Algorithms). 
} An explanation of the algorithm appears further on in the program. 
i CALLING SEQUENCE: 
i STRSDIVIDE (ASIGN.rv.r,AEXP.rl.r, ADIGITS.rnu.dx, 
: BSIGN.rv.r,BEXP.rl.r,BDIGITS.rnu.dx, 
i TOT_DIGITS.rl.r, RND_TRUNC.rv.r, 
CSIGN.wv.r,CEXP.wl.r,CDIGITS.wnu.dx) 
; FORMAL PARAMETERS: 
i ASIGN.rv.r Sign of a x A (O=positive, 1t=negative) 
; AEXP.rl.r Power of 10 by which to multiply the operand A digits 
: to get the absolute value of operand A. 
! x: AEXP=1,ADIGITS=123 gives 1230. 
: ADIGITS.rnu.dx Descriptor for the digits of operand A. 
} BSIGN.rv.r ign of operand B (O=positive, 1=negative) 
‘ BEXP.rl.r Power of 10 by which to multiply the operand B digits 
: to get the absolute vatye of operand B. 
: Ex: BEXP=-1,BDIGITS=123 gives 12.3 
‘ BDIGITS.rnu.dx Descriptor for the eights of operand 8B. 
; TOT_DIGITS.rl.r Number of digits to the right of the decimal point 
: to carry out the division 
: RND_TRUNC.rv.r Round/Truncate parameter (0 = truncate, 1 = round) 
: CSIGN.wv.r Sign of operand C (0=positive, 1=negative) , 
! CEXP.wl.r Power of 10 by which to multiply the operand C digits 
' to get the absolute value of operand C. 
: Ex: CEXP=0,CDIGITS=123 gives " 
CDIGITS.wnu.dx Descriptor for the digits of operand C. 
: IMPLICIT INPUTS: 
-NONE 
i IMPLICIT OUTPUTS: 
i -CSIGN 
: -CEXP 
} -CDIGITS 
ROUTINE VALUE: 
: -NONE 
COMPLETION CODES 
: -NONE 
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1-019 1enSep-198e 2:40:01 Le tartesneSstaantin.ases 1 9° (10) 

: 1889 1974 BEGIN : 
; 1890 1975 : 
>; 1891 1376 MAP : 
; 1996 197 ADIGITS:REF BLOCK (8,BYTE), : 
; 189 1308 BDIGITS:REF BLOCK (8,BYTEJ, ‘ 
; 1894 197 CDIGITS:REF BLOCK (8,BYTEJ; ; 
; 1895 1980 : 
; 18 1981 STACKLOCAL : 
; 189 19 ¢ : 
>; 1898 19 A_LENGTH:WORD, ! Number of digits in A string ; 
; 1899 1984 " , ! Address of A string : 
; 1900 1985 B-LENGTH: WORD, i Number of digits in B string ; 
; 1901 1986 * ! Address of B string : 
: 1908 1987 C“LENGTH: WORD, i Number of digits in result string ; 
; 190 1988 START _BUF , ! Pointer to Ist byte of allocated memory : 
: 1904 1989 ALLEN, : Number of digits needed in A to compute result ‘ 
: 1905 1990 A_CHUNKS, : Number of 15 digit chunks needed in A ; 
; 1906 1991 ABUF , ! Pointer to packed decimal chunks of A : 
; 1907 1336 B_CHUNKS, ! Number of 15 digit chunks in ; 
; 1908 199 BBUF ' Pointer to packed decimal chunks of 8B ’ 
; 1909 1994 DRBUF ! Pointer to D / pointer to rounding chunk ° 
; 1910 1995 Q_LENGTH, ! Number of digit required in the quotient : 
; 1911 1996 CHUNKS, ! Number of 15 digit chunks required in quotient : 
: Mb a 1997 UF, ! Pointer to 15 digit chunks of the quotient : 
: 191 1998 QSTRBUF, : 
3 1914 1999 UF ' Pointer to buffer containing q*B : 
: 1915 2000 STATUS, : Lenguerd for returning status : ‘ 
3; 1916 2001 LAG, ' B_CHUNKS = 1 ==> FLAG = 1, FLAG = 0 otherwise ° 
3; 1917 $008 2 TEMP i Léngword to hold intermediate results : : 
; 1918 2003 2 LEADING_ZEROS, i Number of Leading zeros in the quotient string ; 
3: 1919 2004 2 STORAGE: VECTOR(4,BYTE) INITIAL(2C'0'), ° 
; 1920 2005 2 ! Dummy storage area : 
: 1921 2006 2 BYTES_VM; ! Total bytes of storage ailocated : 


Pointer to string of quotient digits 
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3 13 ; po? peSneeaesoussseeeeqnseseseessensereseorersersotenesenereqeesesessonesenes 
3 ® 
: 12 ; 94 i THE ALGORITHM . 
: 1927 011 i GIVENS: nm = Length of the divisor ‘ 
: 1928 at ' m = Length of e]vi¢ene -n « 
3 1? 2 HF radix = 10 (decimal) ¥ 
Py : # 
3; 1931 015 ! STEP 1. Normalize. Set D = FLOOR (radix/(v1+1)) where vi is the * 
; 19 ¢ 918 ! first digit of the divisor which must ° t be sents Where * 
; 19 01 : UO U1...Um+n represent the chunks of digits of the * 
3; 19 318 ! div dend and V1 V2...Vn represent the ie .. of *45 digits * 
3; 1935 1 ! of the divisor. * 
3 19 020 : Rutt iply A by D thus giving the se wenge of 15 digit * 
3; 1937 021 ' chunks U0 U1 snare. (Note the introduction of the new * 
3 19 0 ¢ : a ) Multiply B by d to obtain a sequence of chunks * 
3 4 8 ? 1 V2...¥n. (Note no new chunk occurs : 
> 1941 025 i STEP 2. Set J = 0. This is the value we will loop on. for this * 
; a 026 ! we Be we will loop “‘LOOP’' number of times. Steps 2-7 * 
3: 194 027 ! will provide the bests for the division of Uj vss oe Uj+n * 
; ib 2098 } by V1 v2...Vn, to get a single quotient digit - Qj. “ 
: 1946 2030 i STEP 3. Calculate the first digit of the quotient: ® 
3 1947 soe. ' If U V1 then se = radix-1. Otherwise, set q = * 
3: 1948 $34 : FLOD (Ujtradic + Uj+1)/V1). Now test if V2"q > * 
3 1949 sot ! (((Uj*tradix + Uj+l = qeV1)*radix)+Uj+2). If so, then * 
: 1950 034 2} decrease q by 1 and repeat this test. When finish q is ‘ 
: 133) soe § either equal to the qoutient digit or one greater. . 
: 1988 Sots STEP 4, multiply and | eet yy Megtece | Uj Uj+l...Uj+n by . 
: 1955 2039 ‘ u) US step consists. of : thy woltiptiearten by a one-place * 
; 1956 seek ; gee combined with a subtraction, The Sigits * 
3; 1957 041 ‘ Uj U +4. .ujen a e kept goers ives if the result of this* 
: 1958 Bk ! step is negative, Uj Uj+ i should be Left as the true * 
3; 1959 045 2! value plus radix raised to the n+l, i.e. as the radix’ * 
3; 1960 Spee , complement of the true value, and a borrow’ to the left * 
3 1991 Be? should be remembered. : 
F 1968 sc9 i STEP 5. Set QC.J] = 9: This is a digit of the quotient. If the * 
> 1964 2048 ' feeuts - STEP 4 was negative, go to STEP 6; otherwise go to * 
3 1oe2 Ben STEP 7 . 
: 1967 Ba ; STEP 6. Decrease QC£.J) by 1. Add OV1 V2...Vn to Uj Uj+1...Uj+tn. : 
F 1398 038 STEP 7. Loop on J. If J <= “LOOP’’ then go back to STEP 3. . 
: 1971 $oee i eeeeeeeeerererereeeeeeeeeeeerererereeeeredeeeerereeeeeereeeeeeeeeeeeeene 
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14 
Validate input descriptors. 


STATUS = LIBSANALYZE_SDESC (.ADIGITS, A.LENGTH, A_ADDR); 
IF .STATUS NEQ SS$_NORMAL 


N 
LIBSSTOP (LIBS_INVARG); ! Unsuccessful status 


STATUS = LIBSANALYZE SDESC (.BDIGITS, B_LENGTH, B_ADDR); 
IF_.STATUS NEQ SS$_NORMAL 


BSSTOP (LIBS_INVARG); ! Unsuccessful status 


ST 
EN 
LI 
STATUS = LIBSANALYZE_SDESC (.CDIGITS, C_LENGTH, TEMP); 
IF STATUS NEQ SS$_NORMAL 


LIBSSTOP (LIBS_INVARG) ; 


Validate input strings - If SPANC returns a zero value all characters are 
digits. If it returns a non-zero value, then TEMP is the address of the 
first non-digit. 


TEMP = SPANC (A_LENGTH, .A_ADDR, SPANC_TABLE, MASK); 
IF . TEMP NEQ 0 ! No match found 


HEN 
ALLENGTH = .TEMP = .A_ADDR; 


TEMP = SPANC (B_LENGTH, .B_ADDR, SPANC_TABLE, MASK); 
IF . TEMP NEQ 0 !' No match found 


HEN 
B_LENGTH = .TEMP = .B_ADDR; 
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1-019 12-80 8=138e 04:28 LIBRTL.SRC Sthakiinses3s1 
; 2005 087 i+ 
; 20 Obs ! *ee BEGIN THE DIVISION ALGORITHM *** 
; 200 089 '- 
:: ee 
3 Bi% H Calculate the resultant sign and exponent. 
; Og 2 ee .CSIGN = ..ASIGN XOR ..BSIGN; 
3; 201 095 -CEXP = =,.TOT_DIGITS; 
: $018 097 5 14 
: Big 098 i stcie off leading zeros for A and B and compute their length. 
; 201 099 ! CHSFIND_NOT_CH returns a null pointer if the desired match on character 
; 2018 100 ! is not Found. To determine if the pointer is null or not, 
; 2019 101 ' one must invoke CHSFAIL which returns a value of one if the pointer 
: 830 13 is null, and a zero if it is not null. 
; 3038 106 2° TEMP = CHSFIND_NOT_CH (.A_LENGTH, .A_ADDR, %C'0"); 
3 $s $132 STATUS = CHSFATL (7TEMP); 
3; 2024 106. IF .STATUS EQL 0 
+. Tide 
3 2027 109 A_LENGTH = .A_LENGTH = (.TE® = .A_ADDR); 
; 2028 110 A-ADOR = .TEMP; 
BG Hn ale 
: 2031 3118 : .CSIGN = 0; 
: 5088 2115 2 TEMP = CHSFIND NOT_CH (.B_LENGTH, .B_ADDR, %C°0"); 
3 2034 2116 2 STATUS = CHSFAIL (TEMP); 
eooe ae eh Pa 
: 2037 2119 LIBSSTOP (STR$_DIVBY_ZER); 
; 2038 2120 B_LENGTH = .B_LENGTH = ([TEMP = .B_ADDR); 
3 $37) gigi B_-ADDR = .TEMP; 
 $0et $158 5 16 
; Hak $ise ; i Calculate maximum number of result digits required 
; 2044 $158 : Q_LENGTH = (.A_LENGTH + ..AEXP) - (.B_ LENGTH + ..BEXP) 
; 2048 3138 + ..TOT_DIGITS + ..RND_TRURC; 
> 2067 129 IF .@ LENGTH LSS 0 
3; 2048 130 THEN 
3 2049 131 '+ 
3; 2050 13 ' Special case for zero quotient 
: $oe2 1 § BEGIN 
: 038 138 LEADING. ZEROS = 0; 
> 2054 136 BYTES VM = MAXU(.C_LENGTH, 1); 
: 2055 137 STATUS = LIBSGET VA (BYTES_VM, START_BUF); 
s $39 ! 8 Ned = STORAGE; 
; $36 140 ELSE 
3 2059 141 BEGIN 
; 2060 136 '¢ 0: . 
; 2061 14 ! Determine the number of digits required in A to obtain the proper number 
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H of digits in the result 


is A_LEN = .B_LENGTH + .Q_LENGTH; 
i Determine the number of 15 digit CHUNKS needed to hold B, the required | 
digits of A and the result digits 
j A_CHUNKS = (.A_LEN + 14)/15; 
BICHUNKS = (.B-LENGTH + 14)/15; 
ro Q_CHUNKS = (.Q_LENGTH + 29)/15; 
h } 


For the algorithm we must have A_CHUNKS >= B_CHUNKS + Q_CHUNKS. 
A_CHUNKS = MAXU(.A_CHUNKS, .B_CHUNKS + .Q_CHUNKS); 


| 
‘+ 
! Determine total storage needed as the maximum of {the storage needed for 
' the computation of the quotient in pacsee decimal, the storage needed to 
convert the quotient to a string, the length of the result string) 
BYTES_VM = 8*(.B_CHUNKS*2 + .A_CHUNKS + 3); ! # of bytes to perform 
! division algorithm in 
! packed decimal. 
TEMP = (.Q_CHUNKS + 1) * 15; ! # of bytes needed to hold 
! quotient string 
BYTES_VM = MAXU (.BYTES_VM, .TEMP + .C_LENGTH); 
! Need .TEMP+.C_LENGTH 
! here to ensure string 
! is long enough for case of 
' zero padding of fixed 
= ! Length strings. 
Allocate working storage and set up pointers into it. 


STATUS = LIBSGET_VM (BYTES_VI, START_BUF); 
RBUF = .START_BOF; 


D ad » A 

QBUF = .DRBUF; 

ABUF = .QBUF + 8; 

BBUF = .ABUF + (.A_CHUNKS + 1)*8; 
QBBUF F + .B 


= .BBU HUNKS*8; 
ss QSTRBUF = .START_BOF + .BYTES_VM - .Q_CHUNKS*15; 
Convert A and B strings to packed decimal. 
; LIBSSCVT_STR_PACK_R9 (.A_ADDR, .A_LENGTH, .A_CHUNKS, .ABUF + 8); 


MOVP (ZREF(15),ZERO, .ABUF) ; 
LIBSSCVT_STR_PACK_R9 (.B_AODR, .B_LENGTH, .B_CHUNKS, .BBUF); 
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= = 


E 
Mec! (ZREF (15), ZERO, .ABUF); 


ELSE 
FLAG = 1; 


: 21 190 

; 2110 191 i “step 1 - Normalize A and B. NOTE: If B_CHUNKS = 1 this step is not necessary 
3 2111 136 i and the computation of q can be sinpliffed. A flag is used to indicate the 
; a 137 _Proper method of evaluating q. FLAG = 1 if .B_CHUNKS = 1 and 0 otherwise. 
: 2114 195 IF .B CHUNKS NEQ 1 

: 2115 19 THEN 

3 138 199 4 BEGIN 

3: 211 138 4 FLAG = 0; 

3 18 199 4 STATUS = LIBSSCALC_D_R7 (.BBUF, , DRBUF ) 

> 211 0 4 IF .STATUS NEQ 1 i STATUS = 1 <s=> D = 1 

3; 2120 1 4 THEN 

: 2121 ¢ BEGIN 

3; 21 § LIBSSMUL_PACK_R10 (.DRBUF, 2 ABUE + 8, .A_CHUNKS, 

> 21 4 [A_CHUNKS + 1, .ABUF 3 8); 

3 2124 5 LIBSSMUL_PACK_R10 (. -DRBUF BBUF, .B CHUNKS, 

; « 06 a .B_CHUNKS, .BBUFJ; 

3; 21 5 08 4 ELS 

3; 2128 09 4 

88 e § 

3; 2131 212 : 


14 
} Ready to start the actual divide algorithm. 


INCR J FROM 0 TO (.Q_CHUNKS*8 - 8) BY 8 DO 
BEGIN 


14 
Step 3 - Calculate digit of quotient. 


STATUS = LIBSSCALC_Q_R9 (.BBUF, .ABUF + .J, .FLAG, .QBUF + .J); 
IF STATUS NEQ 1 


1 LIBSSTOP (LIBS_INVARG); 
; Step 4 - Multiply and subtract. Replace the digits of ABUF by ABUF - Q*BBUF 

LIBSSMUL_PACK_R10 (.QBUF + .J, .BBUF, .B_CHUNKS, 

-B_CHUNKS+1, .QBBUF +8); 

- STATUS = LIBSSSUB_PACK_R8 (.B_CHUNKS, .ABUF + .J, .QBBUF); 
; Step 6 - Adjust q if the resu.c of step 4 was negative 

IF _ .STATUS EQL 1 ! If remainder is negative 

; LIBSSADJUST_Q_R9 (.B_CHUNKS, .ABUF + .J + 8, .BBUF, .QBUF + .J); 

check if rounding is required and round result if necessary 


IF ..RND_TRUNC EQL 1 
THEN 


BEGIN 
TEMP = (.Q_CHUNKS-1)*#15 = .Q_LENGTH; 
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64 

65 Q LENGTH = .Q_LENGTH = 1; 

66 DRBUF = .QBUF™+ (.Q CHUNKS = 1)#8; 

67 LIBSS$ROUND_R7 (.ORBOF, . TEMP); 

$8 END; 

'¢+ 

70 ! Check if 1st chunk of the quotient is zero. If it is, A < B, the number of 
2171 ! leading zeros is 15. Otherwise, see if its less than 10. if it is, then 
$176 ! the number of neg zeros is 14 and the number of digits in the quotient 
217 ! should be increased H 1, Otherwise, the number of leading zeros is 13 and 
gire : the number of digits in the quotient should be increased by 2. 

\r6 STATUS = CMPP (ZREF(15), .QBUF, ZREF(15), ZERO); 

re 5 IF .STATUS EQL 0 

179 9 LEADING_ZEROS = 15 

180 0 LSE 

181 1 BEGIN 

186 § STATUS = CMPP (ZREF(15), .QBUF, ZREF(15), TEN); 

18 IF_.STATUS LSS 0 

184 264 THEN 

185 65 GIN 

186 6 Q LENGTH = .Q_LENGTH + 1; 

1 6 LEADING_ZEROS™= 14; 

1 o8 END 

189 6 ELSE 
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GIN 
Q LENGTH = so. LENGTH + 2; 
LEADING ZEROS = 15; 


END; 


! 
i: 


+ 

Convert the packed number back into its original numeric form. 

LIBSSCVT_PACK_STR_R8 (.QBUF, .Q_CHUNKS, .QSTRBUF); 
END; 

'+ 


! Check descriptor class to see if the string needs to be padded with leading 
! zeros before copying the quotient string to the result string. 


IF 4 ee TaD sc ee CLASS NEQ DSCSK_CLASS_D) AND 
(.CDIGITSCOSCSB_CLASSJ NEQ DSCSK_CLASS_VS) AND 


ww GTR .Q_LENGTH) 


CHSFILL (%C°O', . TEMP, .QSTRBUF); 


ELSE 

QSTRBUF = .QSTRBUF + .LEADING_ZEROS; 
14 
Check the type of descriptor our resultant descriptor is. 
: QSTRBUF = .QSTRBUF + .LEADING ZEROS; 
: CHK_STR_TYPE (QSTRBUF ,Q_LENGTA,.CDIGITS); 
14 
: Copy quotient string to result string and deallocate virtual memory. 

IF .Q LENGTH LEQ 0 
gyrus = LIBSSCOPY_R_DX (ZREF(1),ZREF (ZASCII'O'),.COIGITS) 


STATUS = LIBSSCOPY_R_DX (Q_LENGTH, .QSTRBUF, .CDIGITS); 
STATUS = LIBSFREE_VM (BYTES_VM, START_BUF); 
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A_ADDR 
A“LENGTH 
A IGITS 
» LIBSANALYZE _SDESC 
RO. STATUS 
STATUS, 1 
a 188 INVARG 
#i, LTB$S 
B_ADDR 
B~LENGTH 
i ite 
‘ LIBSANALYZE_ SDESC 
RO 
aT PATO 
$ 
#L1B$ INVARG 
ee LTBS$ST 
C_LENGTH 
CBIGITS 
#3, LIBSANALYZE_SDESC 
RO, STATUS 
STATUS, #1 
3$ 
#LIBS_INVARG 
#1, LIBSSTOP 
A,LENGTH, @A_ADDR, SPANC_TABLE, MASK 
R1 
R1, TEMP 
5$ 
A_ADDR, TEMP, A_LENGTH 
BSLENGTH, @B/ADBR, SPANC_TABLE, MASK 
R1 
Ri TEMP 
B_ADDR, TEMP, B_LENGTH 
@BSIGN, @ASIGN, a@CSIGN 
aToT DIGITS, R3 
R3, SCEXP 
#48, A_LENGTH, @A_ADDR 
8$ 
R1 
R1, TEMP 
RO 
R1 
9$ 
R 
nO, STATUS 
R1, A_ADDR, RO 
RO, A “LENGTH 
R1. A-ADDR 
11§ 
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SIGN 
B, B_LENGTH, @8_ADDR 


arn TRUNC, RO, Q_LENGTH 
-LERGTH , B(SPS 


BYTES 

#2, PTBSGET _VM 
RO, STATUS 
TORAGE, QSTRBUF 


LENGTH, RO 
a0_LENGTHCROJ, A_LEN 
1%, A_LEN, RO 


A- CHUNKS, . 
R8 


ar REHMCSER. 8 RO 
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AE 
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AE 08 AB4 
50 44 
AE 40 
af 10 
5 
59 08 
58 4C 
57 6A 
56 64 
es 000000006 
59 40 
58 bh 
57 62 
56 5¢ 
000000006 
01 4&4 
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56 40 
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ES-VM 

, LIBSGET_VM 
TATU 

TART_BUF, DRBUF 

BUF; QB 

#8, QBUF, ABUF 


a66UF (ROI, QBBUF 
E START_BUF, RO 
STRBUF 


ADDR, R6 
LTgsscvi STR_PACK_R9 
#15, ZERO, (R11) 
BBUF, R9 
B_CHUNKS, R8 
B-LENGTH, R7 

ADDR, R6 
LIBSSCVT_STR_PACK_R9 
B_CHUNKS; #1 


8(R11), R10 
A_CHUNKS, RO 


BUF R 
LIBSSMUL_PACK_R10 
BBUF , 
B CHUNKS, R9 
UF 
DRBUF, R6 
‘gente, 
#15, ZERO, (R11) 
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21$ 
#1, FLAG 
#3, Q_ CHUNKS, 4(SP) 


QBBUF, R10 
#1, B. CHUNKS, 12(SP) 


BBUF. R6 
PTBS$CALC Q_R9 
RO, STAT Sg 
stat 1s : 


rate INVARG 
#1, LIBSSTOP 
QBUF, RO 
J, RO, R6 
12<sP5 RO 
LIBS$MUL_PACK_R10 
J, R11, R7 

BUF R8 

UNKS, R6 

CIBS$suB- PACK_R8 
RO, STATOS 


TATUS. #1 


he ee Q A, 
D_frun¢c, T° 

#15, Q_ CHUNKS, R7 

arsine TEMP 

a3 a CHUNKS, RO 

(ROS, DRBUF 


H R. STATUS 


ze LEADING_ZEROS 
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STRSARITH 16-Sep-1984 01:27:51 AX-11 Bliss-32 V4.0-74 Page 68 
1-019 12-808- 1382 93208 LIBRTL.SRC STRANI IN 03551 . a 
6 BA BR 28 : : 
EFGG OCF 30 BE f 33 el 26$ cHPeS a5, @QBuF, TEN t 2262 : 
54 54 02 ¢ e C EXTZ #2, #2, R4, RG : 3 
24 «AE 01 ¢ CA SUBL3 R4, #1, STATUS : : 
09 1 CF BGEG 278 3 2263 ; 
38 AE OD D1 INCL LENGTH : 66 F 
18 AE rf 04 Dé ROVL ats. LEADING_ ZEROS : 67 ; 
38 AE 0 ¢ DA 27$ ADDL2 #2, Q_LENGTH + 2271 
18 AE D D D MOVL #13, CEADING_ZEROS + 2272 
3 AE p 0 E2 28$: MOVL  QSTRBUF, RB : 2279 
6 AE 70 OO3E MOVG BUF, R : 
000000006 0 16 OO3EA JSB Liesscvi PACK_STR_R8 : 
50 2c Oa C1 0O3FO 29$:  ADDL3 #3, CDIGITS, RO + 2286 
02 $0 91 00 F5 CMPBEs«(RO),, & ; 
: 13 003F8 BEQL 308 ; 
50 2c oa 03 ci 00 FA ADDL3 #3, CDIGITS, RO + 2287 
08 60 91 OO3FF CMPBss«(RO), #11 : 
2 13 90402 BEQL  30$ F 
38 OA 08 A Di 0404 cMPL (SP), Q_LENGTH + 2288 
50 08 AE 38 AE c3 ripe SUBL3 Q LENGTH, 8(SP), RO t 2291 
1c AE 50 18 AE C3 00411 SUBL LEADING ZEROS, RO, TEMP ; 
38 OA 08 AE DO 00417 MOVL (SP), O LENGTH + 2292 
2c AE 1¢ AE C2 0041C SUBL2 TEMP, QSTRBUF : 2293 
1€ «AE DS 00421 TSTL TEMP + 2296 
OF 19 00424 BLSS 31$ ; 
1c «AE 30 6E a 00 2¢ 904 6 MOVCS #0, (SP), #48, TEMP, @QSTRBUF : 2296 
05 11 00426 BRB 31$ : 2286 
2c AE 18 AE CO 00430 308: ADDL2 LEADING ZEROS, QSTRBUF > 2299 
38 «AE D5 00435 31$:  TSTL 4 _LENGTA + 2312 
13 14 004 BGTR 32 F 
2¢ «AC DD 0043A PUSHL (CDIGITS > 2314 
10 AE 30 00 00430 MOVL #48, 16(SP) : 
10 AE 9F 00441 PUSHAB 16(SP) ; 
10 AE 01 DO 00444 MOVL #1, 16(SP) : 
10 AE 9F 00448 PUSHAB 1eisP) : 
09 11 00448 BRB 33$ : 
: AC DD 00440 32$:  PUSHL CDIGITS : 2316 
0 AE pp 0490 PUSHL QSTRBUF : 
40 AE 9F 0045 PUSHAB Q_LENGTH : 
000000006 00 9 FB 496 33$: CALLS 3. LIBSSCOPY_R_DX ; 
24 «AE p 45D MOVL RO, STATUS : 
54 AE 9F 00461 PUSHAB START_BUF : 2317 
14 AE 9F 00464 PUSHAB BYTES ~VM : 
000000006 00 9 FB 0467 CALLS #2, LIBSFREE_VM ; 
24 «AE : O46E MOVL RO. STATUS ; 
4 004 RET > 2318 
; Routine Size: 1139 bytes, Routine Base: _STRSCODE + 0D01 
; 3838 38 ROUTINE CHK_STR_TYPE (SRC_BUF,SRC_LEN,DST_DESC): NOVALUE = 
: 2261 321 1 


15 
STRSARITH 1b-$e =1984 01:27:51 YAX=11 BLiss-32 v4.0-74 
1-019 1 ~300 138% Pt pet LIBRTL.SRCJSTRARITH.B32;1 
> 224 1 'ee 
; $508 gi 
H te ¢ : FUNCTIONAL DESCRIPTION: 
; re] $ ii This routing checks the destination string type and copies 
: 224 , the appropriate number of digits from the source buffer 
: 3 8 ! into it as dictated by the rules of the destination string. 
; 30 0 | ' CALLING SEQUENCE: 
; 2g g } } CHK_STR_TYPE (src_buf.rnu.r,src_len.rl.r,dst_desc.wnu.dx) 
; 3 4 1 / FORMAL PARAMETERS: 
3; 2255 . ea SRC_BUF .rnu.r Addr of the source buffer which contains 
3 2$ $ 1! the diyi.: of the result. 
3 225 1! SRC_LEN.rl.r Lengch of the source string 
; 2258 ee: DST_DESC.wnu.dx Addr of the destination string (where to store 
3 23 44 : the resultant string). 
; 361 41 1! IMPLICIT INPUTS: 
: 5568 33 | i NONE 
; 364 3a 1 i 
; $63 s7 : IMPLICIT OUTPUTS: 
; sor $e5 : DST_DESC Store the resultant string in DST_DESC 
: 3269 349 1 i ROUTINE VALUE: 
; e271 331 1 | -NONE 
; 3278 2338 ! COMPLETION CODES: 
a Be Peon 
: 2277 357 1 | MACROS: 
: 2278 358 1! 
PARSEE 8 oes 
; 381 e361 | | SIDE EFFECTS: 
; 288 s3e8 i -NONE 
3; 2284 2364 1 !- 
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10-30-1984 9b 80:01 CYARTL SRE ISTRARTIN.039;1 2946) 
BEGIN 


MAP 
DST_DESC:REF BLOCK (8,BYTE]; 


LOCAL 
TMP BUF :REF VECTOR(65535,BYTE), 
RESOLT_OIGITS, 


TMP_BUF = .SRC_BUF; 
RESOLT_DIGITS = ..SRC_LEN; 


' 
' Check the class of strings we are dealing with. for 

! dynamic and re strings, return the calculated length; 
a all other classes of ptrings, return the number of 

: n 


haracters specified in the destination descriptor. 


IF (.DST_DESCEDSC$B_CLASS EQL DSCSK_CLASS_D) OR 
(.DSTDESCEDSC$B-~CLASS] EQL DSC$K~CLASS_VS) 
THENGIN 
IF ,DST_DESCLDSC$B_CLASSJ EQL DSC$K_CLASS_VS ! Varying string only 
BEGIN 
RLEN = .DST_DESCCDSC$W_MAXSTRLEND; ' Fetch max string size 
IF .RLEN LSS .RESULT_DIGITS '\If max < actual then 
, ag '/return max # of chars 
i CHSMOVE (.RLEN, TMP_BUF,.DST_DESCCDSCSA_POINTER] + 2); 
: (-DST_DESCLOSCEA POINTER])<0,16> = .RLEN; 
(.DST_DESCLDSCSA_POINTERI) <0, 16> = .RLEN 
: BEGIN '\Just retn # of 
: '/calculated characters 
i CHSMOVE (.RESULT_DIGITS,TMP_BUF,.DST DESCCDSC$A POINTER] + 2); 
: (-DST_DESCLDSCSA_POINTERI) <0, 163 = .RESULT_DIGITS; 


(.DST_DESCCDSC$A_POINTER])<0,16> = .RESULT_DIGITS; 
STRSCOPY_R (,DST_DESC,RLEN, .TMP_BUF); 


ELSE 
'¢ 


' Here we know the string is dynamic. 
Return actual number of characters as calculated in algorithm. 


eat (.DST_DESC,RESULT_DIGITS,.TMP_BUF); 


'¢ 
! Here we know we are dealing with static strings. 
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N 15 | 
RITH 16-Sep-1984 01:27:51 VAX-11 Bliss-32 v4.0-74 Page 71 
eet) a et tt Te 29° 16) 


-—n 


dx 
=e 


oP, 


: $307 £38 oi 
: 2345 404 ELSE 
3 § 425 BEGIN 
: 4 § RLEN = .DST_DESCCDSCS$W_LENGTHI; '\Fetch Length passed 
3 : & '/in output descriptor 
: 2 r 8 IF -RLEN GTR .RESULT_DIGITS ! Given lLength>actual? 
i 2351 430 4 BEGIN ! Yes. 
; 2g “ g & "puplicate ine zero character for the length 
3 4 4 4 i of the string. Then copy the calculated 
; 5 4 4 i numeric string into the appropriate oi feet into 
; 2$ re 5 2 a the destination descriptor. 
: 2358 4 $ 4 STRSDUPL_CHAR (.DST_DESC, RLEN GREF (ZASCII'O")) 
> 2359 438 4 CHSMOVE T.RESULT_DIGITS P BUF, .DST_ DESCLDSCSA_. POINTER] + 
: 3360 459 4 si RLEN =~. RESULf DIGITS); 
; 36¢ 441 4 1+ 
: 36 #4 : Still dealing with static strings here. 
: 38 444 3 ELSE 
: 308 stg 2 BEGIN 
; 447? & ‘+ 
3; 2369 448 4 i For case where RLEN is Less than or equal to 
: 2370 449 4 ' actual length of the result, just copy RLEN dioits 
; $4 343 ? 7 into the output descriptor. 
; 378 43g 4 
3 2374 2453 4 STRSCOPY_R (.DST_DESC.RLEN,.TMP_BUF); 
3 tie Stee 3 END; 
: 2376 455 2 END; 
: 2377 2456 1 END; 
003C 00000 CHK_STR_TYPE: 
-WORD Save R2,R3,R4,R5 ; 2319 
sf oc ¢3 00002 SUBL2 #12, : 
5 04 ac OD O88 MOVL SRC att 5 75 
04 A 08 BC D MOVL he i, RESULT. DIGITS 3 76 
5 BS AC 3 oft MOVL pst fe : 2384 
0 03 A2 91 0001 CMPB (R2), eC, ; 
06 13 1 BEQL 1$ 3 
08 03 A2 91 1 CMPB 3(R2), #11 : 2385 
2 ie 1C BNEQ 4$ : 
08 03 A2 9 1E 1$ CMPB apne) #11 : 2388 
19 12 00 BNEQ $ 3 
08 AE 62 3C MOVZWL (R2), RLEN 3 333) 
04 AE 08 h oI : Has BEEN. RESULT_DIGITS : 92 
04 B2 08 AE 00 0 F MOVW RLEN, @4(R2) : 2399 
3A 1 BRB 5 ° | 
| 
| 
} 
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STRSARITH 16-Sep-1984 7:51 AX-11 Bliss-32 v4.0-74 Page 72 
1-019 14 aati 9}: 26; :01 LIBRTL.SRCJSTRARITH $3.1 9° 16) 
04 82 04 A 80 6 2$: MOVW RESULT DIGITS, a4(R2) : 2407 
; B BRB 5 + 240 
po D 3$: PUSHL TMP_BUF 3 241 
08 Af F F PUSHAB RESOLT_DIGITS ; 
3 ii de BRB 6 : 
08 AE 62 44 4$: MOVZWL (ne RLEN 3 $238 | 
A AE D CMPL nN’ RESUL DIGITS > 26 
4 AE 08 48 CPL RLE T T 
6E § D 4F MOVL is, (SP) + 2637 
E bp e PUSHL SP ; 
OC AE OF PUSHAB RLEN : 
; DD 7 PUSHL R F 
000000006 0 FB 3 CALLS @# STRSDUPL_ CHAR : 
50 04 A 8 AE C 06 ADDL3 LEN, 4(R2), RO + 2439 
5 4 AE g 5 SUBL2 RESULT_DIGITS, RO ; 
60 6 4 AE 8 0906A move RESULTIDIGITS, (TMP_BUF), (RO) oo 
53 DD 00070 5$: PUSHL TMP_BUF : rsd 
™ 53 BF Oto re és PUSHES ae ; | 
000000006 00 03 FB 00077 CALLS , STRSCOPY_R : 
04 0007E RET : 2456 
; Routine Size: 127 bytes, Routine Base: _STRSCODE + 1174 


TRSARITH 2:27:51 AX-11 Bliss-32 V4.0-74 
3549 CiSTRA 


t+ 
Only free strings if this is the UNWIND condition. 


WMEWN—Oo 


OOCooo 


IF ( NOT (LIBSMATCH_COND (SIG C1], ZREF (SS$_UNWIND)))) THEN RETURN (SS$_RESIGNAL); 


4 
Go through the enable arguments, freeing them. 


WAAR MORO ROPOfonony 2 9 9 


ue 


INCR ARG_NO FROM 1 TO .ENBL [0) DO 
IF (,.ENBL C.ARG_NO) NEQ 0) THEN STRSFREE1_DX (.ENBL C.ARG_NOJ); 


384 9} 

-1984 12:40:01 LIBRTL.SR RITH.832;1 
; 2379 457 1 ROUTINE FREE_STRINGS ( ! Free local strings 
; 2380 4 8 1 SIG, ! Signal vector 

5 4 126 : Crer” sed ie ecu 

3 ' Enable vector 

3 BS 461 1 d= 

> 2584 188 1 

3 5 465 1 !+4+4 

: 38 tee : } FUNCTIONAL DESCRIPTION: 

: 2388 466 1! If we are unwinding, free the local strings. They are passed 
$ $50 reef : in the enable vecte?. J : 

: 4! : 4 ! FORMAL PARAMETERS: 

3 38 471 1! $1G.rl.a A counted vector of parameters to LIBSSIGNAL/STOP 
+ 2394 tis 1} MECH.rl.a A counted vector of info from 

3 4 a7 : ENBL.ra.a A counted vector of ENABLE argument addresses. 
3: 2397 475 1! IMPLICIT INPUTS: 

; 2398 476 1! 

3; 2399 477 1! NONE 

: 2400 478 1! 

3; 2401 479 1°! IMPLICIT OUTPUTS: 

; ret 480 1! 

; 240 481 1! NONE 

3: 2404 tee 1! 

3; 2405 4835 1 ! ROUTINE VALUE: 

3; 2406 2484 1 ! COMPLETION CODES: 

3: 2407 485 1! 

3; 2408 486 1! Always SS$_RESIGNAL, which is ignored when unwinding. 

3; 2409 487 1! 

3 0 488 1 ! SIDE EFFECTS: 

: 1 $e5e 1! ‘ 

$ § re ; : Frees all of the strings passed as enable arguments. 

: 4 492 1 !-- 

$ 5 493 1 

3 6 494 BEGIN 

: 7 495 

: 8 49 MAP 

: Q 49 SIG : REF VECTOR 

> 2420 498 MECH : REF VECTOR, 

: 2 499 ENBL : REF VECTOR; 

3 4 

: $e 

3 8 

: 9 

3 0 
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! end of FREE_STRINGS 


STRSARI TN 
-01 


4 
5 ; RETURN (SS$_RESIGNAL); 
6 END; 


0004 00000 rerngeroues 


«WO Save R2 : 2457 
7E 0920 «BF 3C 0002 WOVZWL #2586, -(SP) : 3836 
SE DD 90 PUSH sp : 
7E 04 ac 06 C1 9 ADDL : 
000000006 00 98 FB 00 é CALLS ae. pysbmarcn, COND : 
1B 50 €9 0001 BLBC : 
52 D4 00018 CLRL ARG NO + 2511 
1 11 OOO1A BRB 3 
50 Of BC4 D Bas 1$ MOVL @ENBLCARG_NOJ, RO : 2513 
60 0D 0021 TSTL (RO) z 
09 13 00023 BEQL F 
50 Dd 00025 PUSHL RO : 
000000006 00 01 FB 00027 CALLS #1, STRSFREE1_DXx : 
9 52 0c BC £3 000 3 $3 AOBLEQ ae nek. ARG_ NO, 1$ 3 
50 0918 8F 3¢ 00033 3$ MOVZWL #2328. RO ~ + 2515. 
04 00038 RET : 2516. 


; Routine Size: 57 bytes, Routine Base: _STRSCODE + 11F3 


: 2439 2517 1 END ! end of module STRSARITH 

3: 2440 2518 

3; 2441 2519 0 ELUDOM 

; PSECT SUMMARY 

: Name Bytes Attributes 

: _STRSCODE 4652 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 
3 Library Statistics 

a Ree ge ee Symbols -------- Pages Processing 

s File Total Loaded Percent Mapped Time 


-$255$DUA28: CSYSLIBISTARLET.L32;1 9776 13 0 581 00:00.7 


eo ie op-198e 12:80:01 Mart °SeeSsteantin.038:1 Page 153 


; COMMAND QUALIFIERS 

: BLISS/CHECK=(FIELD, INITIAL,OPTIMIZE) /NOTRACE/LIS=LIS$:STRARITH/OBJ=OBJ$:STRARITH MSRC$:STRARITH/UPDATE=(ENH$: STRARITH) 
Size: 4324 coge + 328 data bytes 
Run Time: 


Elapsed Time: 03:07.9 
Lines/CPU Min: 113 
Lexemes/CPU-Min: 1 Vi 
peaey Used: 373 pages 
Compilation Complete 
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